Index: /branches/publications/ORCHIDEE-AFP/AA_make
===================================================================
--- /branches/publications/ORCHIDEE-AFP/AA_make	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/AA_make	(revision 8430)
@@ -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-AFP/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE-AFP/AA_make.ldef	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/AA_make.ldef	(revision 8430)
@@ -0,0 +1,3 @@
+#- $Id$
+#---------------------------------------------------------------------
+#-
Index: /branches/publications/ORCHIDEE-AFP/DOC/BIB/orchidee.bib
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/BIB/orchidee.bib	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/BIB/orchidee.bib	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowAlb=snowaIni+snowaDec \times \exp{\frac{-snowAge}{tsctSnowa}}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+fracSnow=\frac{snow}{snow+10}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+C = [\frac{1}{\kappa} ln(\frac{z}{z0})]^2 
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 8430)
@@ -0,0 +1,4 @@
+\begin{equation}
+{g_{{s}}(l)={{mA}}(l)\frac{h_{{r}}}{C_{{a}}}+b}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = U_{wind}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zscf = \sqrt{(1 + cd |Ri_{z}|)}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp}=\frac {cd_{neut}}{1+3 c_b Ri_z zscf}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp} = cd_{neut} (1-3 cb* Ri_{z} * zscf)
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_g = Z_{lev} g_0
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_d^\phi = \left( \frac{Z_g} {C_{p,air}} \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{V, surf} = T_g (1 + retv q_{surf})
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Ri_{z} = max \{   min   \{Ri_z, 5    \}, -5  \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    r_{a} = \frac{1}{q_{c,drag}U}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,4} = evap_{bare, lim}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (\beta_{v,2}); \  \sum_1^{nvm} (\beta_{v,3})   
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_v = 1; \ \alpha_v = 1    
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (veget); \  \sum_2^{nvm} (veget)   
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,3} = 0; \ RH = 0     
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,2} = 0       
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    z_{rapp} = \frac{qs_{int}^{veg}}{ziltest}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,2} = \beta_{v,2} z_{rapp}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \delta _c = \rho . max\{ (q_{sat} - q_{a}), 0 \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{old} = T_S C_p
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \frac{\delta q_s^{old}}{\delta t} = \delta q_s 
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{LW}_{abs} = \epsilon R^{LW}_{\downarrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Interception) = xx \beta_{v2}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Transpiration) = xx \beta_{v3}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   U = max \{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U=max\{U_{min}, \sqrt{u^2+v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = \rho q_c (ps^{new}- E^{pot}_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   R^{LW}_{net} = R^{LW}_{\downarrow}-R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T_{air}= \frac{E^{pot}_{air}}{c_{p, air}}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_c=|v|q_{c, drag}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 8430)
@@ -0,0 +1,4 @@
+\begin{equation}
+    R^{LW}_{\uparrow}=R^{LW}_{\uparrow}+(1-\epsilon)R^{LW}_{\downarrow}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{rad}=\epsilon \sigma T_{s}^4 + R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_s = max \{q_s, q_{air} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R_{net}=R^{LW}_{\downarrow}+R^{SW}_{net}-R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    (fusion) = (melt)_{tot} \frac {\lambda E_{sub}^0}{\Delta t}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max \{ U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{new} = ps^{old} + \Delta \theta
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = \frac {ps^{new}}{C_p^{air}}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{air}^{new}(ji) = q_{air}(ji)
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 8430)
@@ -0,0 +1,4 @@
+\begin{equation}
+    A_T^{orc} = B_T^{lmdz} \Delta t
+\end{equation}
+
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_T^{orc} = A_T^{lmdz}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    A_q^{orc} = B_q^{lmdz} \Delta t
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_q^{orc} = A_q^{lmdz}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 8430)
@@ -0,0 +1,4 @@
+\begin{eqnarray}\label(eq:drs}
+R_s & = & 0.05 R \\
+D & = & 0.95 R
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:us1}
+U_s=  \exp (-c_j \, h_t^d )
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowmelt=\frac{(temp\_sol\_new - tp\_00)*soilcap}{chalfu0}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+\frac{\partial T}{\partial t}=\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = k_{allom2} \times D^{k_{allom3}}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+    CA =\min(k_{allom1} \times D^{k_{rp}},CA_{max})
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 8430)
@@ -0,0 +1,6 @@
+\begin{equation}
+p(m)=e^{-\pi*\left(\frac{m}{m_e}\right)^{2}}
+\end{equation}
+
+
+
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 8430)
@@ -0,0 +1,4 @@
+\begin{equation}
+greff=\frac{\Delta}{C_{leaf}*SLA}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+mort_{greff}=\frac{k_{mort1}}{1+k_{mort2}*greff}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+A\propto \frac{\sum X_{i}}{\sum X_{i}+\sum Y_{j}}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=MAX(0.25,MIN(1,M)
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=e^{0.69*(\frac{temp-303}{10})}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   DLC=1-e^{(-0.5*LAI)}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=-1.1*soilmoisture^2+2.4*soilmoisture-0.29
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   F=0.85-0.018*L*CN
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   k=\frac{1}{litter tau}*T*M
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dDL}{dt}=DL*(1-k)
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dInput}{dt}=f*C*(1-L)
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dLAI}{dt}=DL*sla*vegetmax
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+ncd_{max} = 3. * one\_year 
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+Flux_{active}=Flux_{active}\cdot(1-0.75\times clay) . \nonumber
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_{pool} = C_{pool}-Flux_{pool}
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 8430)
@@ -0,0 +1,3 @@
+\begin{equation}
+Resp_{soil}=\sum_{pool}(f_{pool\rightarrow atmosphere}\times Flux_{pool}).
+\end{equation}
Index: /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 8430)
@@ -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-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 8430)
@@ -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-AFP/DOC/TOOLS/codealgo.awk
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/TOOLS/codealgo.awk	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/TOOLS/codealgo.awk	(revision 8430)
@@ -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-AFP/DOC/TOOLS/codedox.awk
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/TOOLS/codedox.awk	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/TOOLS/codedox.awk	(revision 8430)
@@ -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-AFP/DOC/TOOLS/codeinc.awk
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/TOOLS/codeinc.awk	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/TOOLS/codeinc.awk	(revision 8430)
@@ -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-AFP/DOC/footer.tex
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/footer.tex	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/footer.tex	(revision 8430)
@@ -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-AFP/DOC/header.tex.init
===================================================================
--- /branches/publications/ORCHIDEE-AFP/DOC/header.tex.init	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/DOC/header.tex.init	(revision 8430)
@@ -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-AFP/Doxyfile_ORCHIDEE.init
===================================================================
--- /branches/publications/ORCHIDEE-AFP/Doxyfile_ORCHIDEE.init	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/Doxyfile_ORCHIDEE.init	(revision 8430)
@@ -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-AFP/ORCHIDEE_CeCILL.LIC
===================================================================
--- /branches/publications/ORCHIDEE-AFP/ORCHIDEE_CeCILL.LIC	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/ORCHIDEE_CeCILL.LIC	(revision 8430)
@@ -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-AFP/arch/arch-X64_ADA.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_ADA.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_ADA.fcm	(revision 8430)
@@ -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-AFP/arch/arch-X64_ADA.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_ADA.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_ADA.path	(revision 8430)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="${NETCDF_LDFLAGS:--L/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:--I/smplocal/pub/HDF5/1.8.9/par/include -I/smplocal/pub/NetCDF/4.1.3/mpi/include}"
+IOIPSL_INCDIR="-I${ORCHDIR}/../../lib -I${ORCHDIR}/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L${ORCHDIR}/../../lib -lioipsl -L${ORCHDIR}/../IOIPSL/lib"
+XIOS_INCDIR=-I${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_CURIE.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_CURIE.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_CURIE.fcm	(revision 8430)
@@ -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
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_CURIE.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_CURIE.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_CURIE.path	(revision 8430)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="-L$NETCDF_LIBDIR -lnetcdff -lnetcdf -lstdc++"
+NETCDF_INCDIR=-I$NETCDF_INCDIR
+IOIPSL_INCDIR=-I${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=-L${ORCHDIR}/../../lib
+XIOS_INCDIR=-I${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE-AMD.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE-AMD.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE-AMD.fcm	(revision 8430)
@@ -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 -init=arrays -init=snan
+%MPI_FFLAGS
+%OMP_FFLAGS          -qopenmp -qopenmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -qopenmp
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE-AMD.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE-AMD.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE-AMD.path	(revision 8430)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="-L$NETCDF_LIBDIR -lnetcdf -L$NETCDFFORTRAN_LIBDIR -lnetcdff -lstdc++"
+NETCDF_INCDIR="-I$NETCDF_INCDIR -I$NETCDFFORTRAN_INCDIR"
+IOIPSL_INCDIR="-I${ORCHDIR}/../../lib -I${ORCHDIR}/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L${ORCHDIR}/../../lib -lioipsl -L${ORCHDIR}/../IOIPSL/lib"
+XIOS_INCDIR=-I${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE.fcm	(revision 8430)
@@ -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 -init=arrays -init=snan
+%MPI_FFLAGS
+%OMP_FFLAGS          -qopenmp -qopenmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -qopenmp
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_IRENE.path	(revision 8430)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="-L$NETCDF_LIBDIR -lnetcdf -L$NETCDFFORTRAN_LIBDIR -lnetcdff -lstdc++"
+NETCDF_INCDIR="-I$NETCDF_INCDIR -I$NETCDFFORTRAN_INCDIR"
+IOIPSL_INCDIR="-I${ORCHDIR}/../../lib -I${ORCHDIR}/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L${ORCHDIR}/../../lib -lioipsl -L${ORCHDIR}/../IOIPSL/lib"
+XIOS_INCDIR=-I${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_JEANZAY.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_JEANZAY.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_JEANZAY.fcm	(revision 8430)
@@ -0,0 +1,15 @@
+%COMPILER            mpiifort
+%LINK                mpiifort
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             CPP_FLUSH 
+%BASE_FFLAGS         -integer-size 32 -real-size 64 -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 -init=arrays -init=snan
+%MPI_FFLAGS
+%OMP_FFLAGS          -qopenmp
+%BASE_LD             
+%MPI_LD
+%OMP_LD              -qopenmp
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_JEANZAY.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_JEANZAY.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_JEANZAY.path	(revision 8430)
@@ -0,0 +1,7 @@
+NETCDF_INCDIR=""
+NETCDF_LIBDIR="-lnetcdff -lnetcdf -lstdc++"
+IOIPSL_INCDIR="-I${ORCHDIR}/../../lib -I${ORCHDIR}/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L${ORCHDIR}/../../lib -lioipsl -L${ORCHDIR}/../IOIPSL/lib"
+XIOS_INCDIR="-I${ORCHDIR}/../XIOS/inc"
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-X64_OCCIGEN.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_OCCIGEN.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_OCCIGEN.fcm	(revision 8430)
@@ -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-AFP/arch/arch-X64_OCCIGEN.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-X64_OCCIGEN.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-X64_OCCIGEN.path	(revision 8430)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="-L$NETCDF_LIB_DIR $NETCDFF_LIBDIR -lnetcdff -lnetcdf -lstdc++"
+NETCDF_INCDIR="-I$NETCDF_INC_DIR -I$NETCDFF_INCDIR"
+IOIPSL_INCDIR="-I${ORCHDIR}/../../lib -I${ORCHDIR}/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L${ORCHDIR}/../../lib -lioipsl -L${ORCHDIR}/../IOIPSL/lib"
+XIOS_INCDIR=-I${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-gfortran.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-gfortran.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-gfortran.fcm	(revision 8430)
@@ -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-AFP/arch/arch-gfortran.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-gfortran.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-gfortran.path	(revision 8430)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="-L/usr/local/lib -lnetcdf -lnetcdff"
+NETCDF_INCDIR=-I/usr/local/include
+IOIPSL_INCDIR="-I${ORCHDIR}/../../lib -I${ORCHDIR}/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L${ORCHDIR}/../../lib -lioipsl -L${ORCHDIR}/../IOIPSL/lib"
+XIOS_INCDIR=-I${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_CICLAD.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_CICLAD.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_CICLAD.fcm	(revision 8430)
@@ -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-AFP/arch/arch-ifort_CICLAD.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_CICLAD.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_CICLAD.path	(revision 8430)
@@ -0,0 +1,6 @@
+NETCDF_LIBDIR="-L/opt/netcdf42/ifort/lib -lnetcdf -lnetcdff -lstdc++"
+NETCDF_INCDIR=-I/opt/netcdf42/ifort/include
+IOIPSL_INCDIR="-I${ORCHDIR}/../../lib -I${ORCHDIR}/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L${ORCHDIR}/../../lib -lioipsl -L${ORCHDIR}/../IOIPSL/lib"
+XIOS_INCDIR=-I${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_LSCE.fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_LSCE.fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_LSCE.fcm	(revision 8430)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -fp-model precise  
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_LSCE.path
===================================================================
--- /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_LSCE.path	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/arch/arch-ifort_LSCE.path	(revision 8430)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="-L/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=-I/usr/local/install/netcdf-4.3.2p/include
+IOIPSL_INCDIR="-I${ORCHDIR}/../../lib -I${ORCHDIR}/../IOIPSL/inc"
+IOIPSL_LIBDIR="-L${ORCHDIR}/../../lib -lioipsl -L${ORCHDIR}/../IOIPSL/lib"
+XIOS_INCDIR=-I${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="-L${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE-AFP/bld.cfg
===================================================================
--- /branches/publications/ORCHIDEE-AFP/bld.cfg	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/bld.cfg	(revision 8430)
@@ -0,0 +1,80 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+
+inc arch.fcm
+inc config.fcm
+
+%ROOT_PATH         $PWD
+%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
+
+#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-AFP/makeorchidee_fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/makeorchidee_fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/makeorchidee_fcm	(revision 8430)
@@ -0,0 +1,558 @@
+#!/bin/bash
+
+#==============================================================================================================================\n
+#  MODULE 	: makeorchidee_fcm
+# 
+#  CONTACT      : orchidee-help _at_ listes.ipsl.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
+
+arch_default_path="arch"
+arch_path="arch"
+
+# Path to store files produced during compilation
+# Note: config_path was previously named .config
+rel_config_path=build
+config_path=$ORCHDIR/${rel_config_path}
+
+
+# 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
+
+
+#########################################################################
+# 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 ;;
+
+    "-arch_path")
+	arch_path=$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. 
+
+[ -arch_path XXX ] : directory of the archicture file containg platform dependent compile options. 
+                     Default is ./arch directory. If the files are not found in the folder, the default ./arch folder will be used. 
+
+[ -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, 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 not 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
+    # Remove the whole directory created during previous compilation
+    rm -fr ${config_path}
+
+    # Clean ORCHIDEE modules in modipsl/lib folder
+    rm -f ../../lib/intersurf.mod
+    rm -f ../../lib/sechiba.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
+
+    echo Clean files created during previous compilation of ORCHIDEE done
+
+    exit
+fi
+
+#########################################################################
+# 6. Prepare compilation
+#
+# Add fcm in environement path
+export PATH=${fcm_path}:${PATH}
+
+# Define architecture files
+if [[ "$arch" != "NONE" ]] ; then
+  # First search for file in arch_path folder, if they are not there, search in arch_default_path
+  if [[ -e $arch_path/arch-${arch}.path ]] ; then
+    rm -f arch.path
+    ln -s $arch_path/arch-${arch}.path arch.path
+  elif [[ -e $arch_default_path/arch-${arch}.path ]] ; then
+    rm -f arch.path
+    ln -s $arch_default_path/arch-${arch}.path arch.path
+  fi
+        
+  if [[ -e $arch_path/arch-${arch}.fcm ]] ; then
+    rm -f arch.fcm
+    ln -s $arch_path/arch-${arch}.fcm arch.fcm
+  elif [[ -e $arch_default_path/arch-${arch}.fcm ]] ; then
+    rm -f arch.fcm
+    ln -s $arch_default_path/arch-${arch}.fcm arch.fcm
+  fi
+
+  if [[ -e $arch_path/arch-${arch}.env ]] ; then
+    rm -f arch.env
+    ln -s $arch_path/arch-${arch}.env arch.env
+  elif [[ -e $arch_default_path/arch-${arch}.env ]] ; then
+    rm -f arch.env
+    ln -s $arch_default_path/arch-${arch}.env arch.env
+  else
+    ln -s .void_file arch.env
+  fi
+  source arch.env
+  source arch.path
+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, exit now...."
+    exit
+  fi
+
+  if [[ -e arch.path ]] ; then
+    source arch.path
+  else
+    echo "architecture file : << arch.path >> is missing, exit now...."
+    exit
+  fi
+
+  if [[ -e arch.env ]] ; then
+    source arch.env
+  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
+
+#
+# Create some temporary variable to which we add as needed
+#
+INCDIR="$NETCDF_INCDIR $IOIPSL_INCDIR"
+LIBDIR="$NETCDF_LIBDIR $IOIPSL_LIBDIR"
+
+# Do we need to link with XIOS
+#
+if [[ "$xios" == "TRUE" ]] ; then
+    CPP_KEY="XIOS ${CPP_KEY}"
+    INCDIR="${INCDIR} $XIOS_INCDIR"
+    LIBDIR="${LIBDIR} $XIOS_LIBDIR"
+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
+
+# set target
+TARGET=liborchidee.a
+if [[ "$is_driver_opt" == "TRUE" ]] ; then
+    TARGET="liborchidee_ol.a dim2_driver.exe orchideedriver.exe"
+fi
+if [[ "$is_other_opt" == "TRUE" ]] ; then
+    TARGET="${TARGET} teststomate.exe forcesoil.exe testrouting.exe"
+fi
+
+if [[ "$is_oasisdriver_opt" == "TRUE" ]] ; then
+    CPP_KEY="OASIS ${CPP_KEY}"
+    TARGET="${TARGET} driver2oasis.exe orchideeoasis.exe"
+    INCDIR="${INCDIR} ${OASIS_INCDIR}/psmile.MPI1 ${OASIS_INCDIR}/scrip  ${OASIS_INCDIR}/mct"
+    LIBDIR="${LIBDIR} ${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 "%CONFIG_PATH   $config_path"                      >> $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_path}/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_path}/fcm.bld.lock
+    else
+	echo "Exit now!!!"
+	exit 1
+    fi
+fi
+
+#########################################################################
+# 7. Do the compiling
+fcm build -j $job $full
+err=$?
+
+# Check error message from fcm build
+if [ $err != 0 ] ; then  
+  # ERROR IN COMPILING 
+  echo ERROR IN COMPILING ORCHIDEE : $err  
+  exit 1 
+fi 
+
+# Create link to bin, lib and inc folders directly in ORCHIDEE folder
+# Use rel_config_path to create link with the relative path
+rm -r bin ; rm -r lib; rm -r inc
+ln -s ${rel_config_path}/bin bin
+ln -s ${rel_config_path}/lib lib
+ln -s ${rel_config_path}/inc inc
+ 
+# Copy into modipsl/lib directory libraries and interface module needed by LMDZ
+cp ${config_path}/lib/lib*a          ../../lib/.
+cp ${config_path}/inc/intersurf.mod  ../../lib/.
+cp ${config_path}/inc/sechiba.mod    ../../lib/.
+
+# Move created executables to modipsl/bin directory
+if [ -f ${config_path}/bin/dim2_driver.exe ]    ; then cp -f ${config_path}/bin/dim2_driver.exe ../../bin/orchidee_ol ; fi
+if [ -f ${config_path}/bin/teststomate.exe ]    ; then cp -f ${config_path}/bin/teststomate.exe ../../bin/teststomate ; fi
+if [ -f ${config_path}/bin/forcesoil.exe ]      ; then cp -f ${config_path}/bin/forcesoil.exe ../../bin/forcesoil ; fi
+if [ -f ${config_path}/bin/orchideedriver.exe ] ; then cp -f ${config_path}/bin/orchideedriver.exe ../../bin/orchideedriver ; fi
+if [ -f ${config_path}/bin/testrouting.exe ]    ; then cp -f ${config_path}/bin/testrouting.exe ../../bin/testrouting ; fi
+if [ -f ${config_path}/bin/driver2oasis.exe ]   ; then cp -f ${config_path}/bin/driver2oasis.exe ../../bin/driver2oasis ; fi
+if [ -f ${config_path}/bin/orchideeoasis.exe ]  ; then cp -f ${config_path}/bin/orchideeoasis.exe ../../bin/orchideeoasis ; fi
+
+
Index: /branches/publications/ORCHIDEE-AFP/orchidee.default
===================================================================
--- /branches/publications/ORCHIDEE-AFP/orchidee.default	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/orchidee.default	(revision 8430)
@@ -0,0 +1,1721 @@
+#
+#
+#  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) 
+#*******************************************************************************************
+
+# LWDOWN_CONS ([FLAG]) :  Conserve longwave downwelling radiation in the forcing 	{}
+LWDOWN_CONS =  n 
+
+# SWDOWN_CONS ([FLAG]) :  Conserve shortwave downwelling radiation in the forcing 	{}
+SWDOWN_CONS =  LWDOWN_CONS 
+
+# 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 
+
+# SPRED_PREC ([-]) :  Spread the precipitation. 	{[-]}
+SPRED_PREC =  Half of the forcing time step or uniform, depending on dt_force and dt_sechiba 
+
+# ATM_CO2 ([ppm]) :  Value to precribe atmosoheric CO2 	{[FORCE_CO2_VEG=y or Offline mode]}
+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 =  y 
+
+# 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 
+
+# STOMATE_OK_STOMATE ([FLAG]) :  Activate STOMATE? 	{OK_SECHIBA}
+STOMATE_OK_STOMATE =  y 
+
+# DO_WOOD_HARVEST ([FLAG]) :  Activate Wood Harvest ? 	{OK_STOMATE}
+DO_WOOD_HARVEST =  y 
+
+# 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 
+
+# DEPTH_MAX_T (m) :  Maximum depth of the soil thermodynamics 	{}
+DEPTH_MAX_T =  90.0 
+
+# DEPTH_MAX_H (m) :  Maximum depth of soil moisture 	{}
+DEPTH_MAX_H =  2.0 
+
+# 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 
+
+# TAU_OUTFLOW ([days]) :  Number of days over which the coastal- and riverflow will be distributed 	{Only in coupled mode}
+TAU_OUTFLOW =  0 
+
+# 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) 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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  	{ }
+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  	{ }
+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  	{ }
+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 	{}
+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., 45.0, 45.0, 35.0, 40.0, 50.0, 45.0, 35.0, 35.0, 50.0, 50.0, 60.0, 60.0 
+
+# 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 	{}
+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 	{}
+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 	{}
+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  	{ }
+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) 	{}
+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 	{}
+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 	{}
+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  	{}
+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 	{}
+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 	{}
+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 	{}
+fQ =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 1., -9999., 1. 
+
+# fpseudo ([-]) :  Fraction of electrons at PSI that follow pseudocyclic transport  	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 	{}
+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 =  1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1. 
+
+# STRESS_GM ([-]) :  Stress on gm 	{OK_SECHIBA or OK_STOMATE}
+STRESS_GM =  1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1. 
+
+# 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 [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.74, 0.0, 0.0, 0.08, 0.24, 0.07, 0.18, 0.18, 0.33, 0.57, 0.57, 0.57, 0.57 
+
+# 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.50, 0.0, 0.0, 0.10, 0.37, 0.08, 0.16, 0.17, 0.27, 0.44, 0.44, 0.44, 0.44   
+
+# 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.21, 0.0, 0.0, 0.14, 0.08, 0.17, 0.05, 0.06, 0.09, 0.15, 0.15, 0.15, 0.15  
+
+# 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.13, 0.0, 0.0, 0.10, 0.10, 0.16, 0.04, 0.07, 0.08, 0.12, 0.12, 0.12, 0.12 
+
+# ALB_LEAF_VIS ([-]) :  leaf albedo of vegetation type, visible albedo 	{OK_SECHIBA}
+ALB_LEAF_VIS =  0.00, 0.04, 0.04, 0.04, 0.04, 0.03, 0.03, 0.03, 0.03, 0.06, 0.06, 0.06, 0.06 
+
+# ALB_LEAF_NIR ([-]) :  leaf albedo of vegetation type, near infrared albedo 	{OK_SECHIBA}
+ALB_LEAF_NIR =  0.00, 0.23, 0.18, 0.18, 0.20, 0.24, 0.15, 0.26, 0.20, 0.24, 0.27, 0.28, 0.26 
+
+# 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., 0.35, 0.35, 0.28, 0.28, 0.28, 0.35, 0.35, 0.35, 0.28, 0.28, 0.28, 0.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., 0.12, 0.12, 0.16, 0.16, 0.16, 0.25, 0.25, 0.25, 0.16, 0.12, 0.16, 0.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.0, 5.0, 5.0, 4.0, 5.0, 3.5, 4.0, 3.0, 2.5, 2.0, 5.0, 5.0 
+
+# 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. 
+
+# ALWAYS_INIT ([BOOLEAN]) :  Take carbon from atmosphere if carbohydrate reserve too small 	{OK_STOMATE}
+ALWAYS_INIT =  y, y, y, y, y, y, y, y, y, y, n, y, y 
+
+# 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 =  y 
+
+# 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 
+
+# VEGET_REINIT ([FLAG] ) :  Reset veget_year counter (obsolet) 	{VEGET_UPDATE > 0Y}
+VEGET_REINIT =  y 
+
+# VEGETMAP_RESET ([FLAG] ) :  Flag to change vegetation map without activating LAND USE change for carbon fluxes and reset carbon related variables to zero 	{}
+VEGETMAP_RESET =  n 
+
+# VEGET_YEAR ([FLAG] ) :  Year of the vegetation map to be read 	{}
+VEGET_YEAR =  1 
+
+# MAXMASS_SNOW ([kg/m^2]  ) :  The maximum mass of a snow 	{OK_SECHIBA}
+MAXMASS_SNOW =  3000. 
+
+# SNOWCRI ([kg/m^2]  ) :  Sets the amount above which only sublimation occures  	{OK_SECHIBA}
+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 
+
+# OK_NUDGE_MC ([FLAG]) :  Activate nudging of soil moisture 	{}
+OK_NUDGE_MC =  n 
+
+# NUDGE_TAU_MC ([-]) :  Relaxation time for nudging of soil moisture expressed in fraction of the day 	{OK_NUDGE_MC}
+NUDGE_TAU_MC =  1 
+
+# OK_NUDGE_SNOW ([FLAG]) :  Activate nudging of snow variables 	{}
+OK_NUDGE_SNOW =  n 
+
+# NUDGE_TAU_SNOW ([-]) :  Relaxation time for nudging of snow variables 	{OK_NUDGE_SNOW}
+NUDGE_TAU_SNOW =  1 
+
+# NUDGE_INTERPOL_WITH_XIOS ([FLAG]) :  Activate reading and interpolation with XIOS for nudging fields 	{OK_NUDGE_MC or OK_NUDGE_SNOW}
+NUDGE_INTERPOL_WITH_XIOS =  n 
+
+# 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 =  y 
+
+# IMPOSE_AZE ([FLAG]) :  Should the surface parameters be prescribed 	{OK_SECHIBA}
+IMPOSE_AZE =  n 
+
+# CONDVEG_Z0 ([m]) :  Surface roughness 	{IMPOSE_AZE}
+CONDVEG_Z0 =  0.15 
+
+# ROUGHHEIGHT ([m] ) :  Height to be added to the height of the first level 	{IMPOSE_AZE}
+ROUGHHEIGHT =  0.0 
+
+# CONDVEG_ALBVIS ([-]) :  SW visible albedo for the surface 	{IMPOSE_AZE}
+CONDVEG_ALBVIS =  0.25 
+
+# CONDVEG_ALBNIR ([-]  ) :  SW near infrared albedo for the surface 	{IMPOSE_AZE}
+CONDVEG_ALBNIR =  0.25 
+
+# CONDVEG_EMIS ([-] ) :  Emissivity of the surface for LW radiation 	{IMPOSE_AZE}
+CONDVEG_EMIS =  1.0 
+
+# 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 =  y 
+
+# DOWNREGULATION_CO2_BASELEVEL ([ppm]   ) :  CO2 base level 	{OK_SECHIBA }
+DOWNREGULATION_CO2_BASELEVEL =  380. 
+
+# GB_REF ([s m-1]   ) :  Leaf bulk boundary layer resistance 	{}
+GB_REF =  1./25. 
+
+# CLAYFRACTION_DEFAULT ([-]   ) :  default fraction of clay 	{OK_SECHIBA }
+CLAYFRACTION_DEFAULT =  0.2  
+
+# SANDFRACTION_DEFAULT ([-]   ) :  default fraction of sand 	{OK_SECHIBA }
+SANDFRACTION_DEFAULT =  0.4  
+
+# SILTFRACTION_DEFAULT ([-]   ) :  default fraction of silt 	{OK_SECHIBA }
+SILTFRACTION_DEFAULT =  0.4  
+
+# 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 ([-]  ) :   	{}
+LAI_LEVEL_DEPTH =  0.15 
+
+# Oi ([ubar]  ) :  Intercellular oxygen partial pressure 	{}
+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 
+
+# 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 =  7.0 
+
+# CARBON_TAU_IPASSIVE ([days] ) :  residence times in carbon pools 	{OK_STOMATE }
+CARBON_TAU_IPASSIVE =  300. 
+
+# 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]) :   	{}
+NOBIO_WATER_CAPAC_VOLUMETRI =  150. 
+
+# SECHIBA_QSINT  ([m]) :  Interception reservoir coefficient 	{OK_SECHIBA }
+SECHIBA_QSINT  =  0.02 
+
+# OK_FREEZE ([FLAG]) :  Activate the complet soil freezing scheme 	{OK_SECHIBA }
+OK_FREEZE =  TRUE 
+
+# 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 
+
+# OK_FREEZE_THAW_LATENT_HEAT ([FLAG]) :  Activate latent heat part of the soil freezing scheme 	{}
+OK_FREEZE_THAW_LATENT_HEAT =  FALSE  
+
+# POROS ([-] ) :  Soil porosity  	{OK_SECHIBA}
+POROS =  0.41 
+
+# fr_dT ([K] ) :  Freezing window     	{OK_SECHIBA}
+fr_dT =  2.0 
+
+# 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  	{OK_FREEZE_CWRR}
+OK_THERMODYNAMICAL_FREEZING =  True 
+
+# CHECK_CWRR ([FLAG]) :  Calculate diagnostics to check CWRR water balance 	{}
+CHECK_CWRR =  n 
+
+# VEGET_UPDATE ([years]) :  Update vegetation frequency: 0Y or 1Y 	{}
+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 
+
+# 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 
+
+# SAND_FRACTION ([-] ) :  Fraction of the clay fraction (0-dim mode) 	{IMPOSE_VEG and IMPOSE_SOIL}
+SAND_FRACTION =  0.4 
+
+# 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 	{}
+VEGETATION_FILE =  PFTmap.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 
+
+# WOODHARVEST_FILE ([FILE]) :  Name of file from which the wood harvest will be read 	{DO_WOOD_HARVEST}
+WOODHARVEST_FILE =  woodharvest.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_MODIS}
+ALB_BG_FILE =  alb_bg.nc 
+
+# CDRAG_FROM_GCM ([FLAG]) :  Keep cdrag coefficient from gcm. 	{OK_SECHIBA}
+CDRAG_FROM_GCM =  y 
+
+# 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 
+
+# DO_PONDS ([FLAG]) :  Should we include ponds  	{}
+DO_PONDS =  n 
+
+# FROZ_FRAC_CORR  ([-]) :  Coefficient for the frozen fraction correction 	{OK_FREEZE}
+FROZ_FRAC_CORR  =  1.0 
+
+# MAX_FROZ_HYDRO ([-]) :  Coefficient for the frozen fraction correction 	{OK_FREEZE}
+MAX_FROZ_HYDRO =  1.0 
+
+# SMTOT_CORR ([-]) :  Coefficient for the frozen fraction correction 	{OK_FREEZE}
+SMTOT_CORR =  2.0 
+
+# DO_RSOIL ([FLAG]) :  Should we reduce soil evaporation with a soil resistance 	{}
+DO_RSOIL =  n 
+
+# OK_DYNROOT ([FLAG]) :  Calculate dynamic root profile to optimize soil moisture usage   	{}
+OK_DYNROOT =  n 
+
+# CWRR_N_VANGENUCHTEN ([-]) :  Van genuchten coefficient n 	{}
+CWRR_N_VANGENUCHTEN =  1.89, 1.56, 1.31 
+
+# CWRR_A_VANGENUCHTEN ([1/mm]  ) :  Van genuchten coefficient a 	{}
+CWRR_A_VANGENUCHTEN =  0.0075, 0.0036, 0.0019 
+
+# VWC_RESIDUAL ([m3/m3]  ) :  Residual soil water content 	{}
+VWC_RESIDUAL =  0.065, 0.078, 0.095 
+
+# VWC_SAT ([m3/m3]  ) :  Saturated soil water content 	{}
+VWC_SAT =  0.41, 0.43, 0.41 
+
+# CWRR_KS  ([mm/d]   ) :  Hydraulic conductivity Saturation 	{}
+CWRR_KS  =  1060.8, 249.6, 62.4 
+
+# WETNESS_TRANSPIR_MAX ([-]    ) :  Soil moisture above which transpir is max 	{}
+WETNESS_TRANSPIR_MAX =  0.5, 0.5, 0.5 
+
+# VWC_FC  ([m3/m3]   ) :  Volumetric water content field capacity 	{}
+VWC_FC  =  0.32, 0.32, 0.32 
+
+# VWC_WP ([m3/m3]   ) :  Volumetric water content Wilting pt 	{}
+VWC_WP =  0.10, 0.10, 0.10  
+
+# VWC_MIN_FOR_WET_ALB ([m3/m3]  ) :  Vol. wat. cont. above which albedo is cst 	{}
+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 	{}
+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_MOISTURE_CONTENT =  0.3 
+
+# US_INIT ([-]) :  US_NVM_NSTM_NSLM 	{}
+US_INIT =  0.0 
+
+# ZWT_FORCE ([m]) :  Prescribed water depth, dimension nstm 	{}
+ZWT_FORCE =  -9999. -9999. -9999. 
+
+# FREE_DRAIN_COEF ([-]) :  Coefficient for free drainage at bottom, dimension nstm 	{}
+FREE_DRAIN_COEF =  1.0 1.0 1.0 
+
+# WATER_TO_INFILT ([mm]) :  Water to be infiltrated on top of the soil 	{}
+WATER_TO_INFILT =  0.0 
+
+# EVAPNU_SOIL ([mm]) :  Bare soil evap on each soil if not found in restart 	{}
+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))  	{}
+CWRR_NKS_N0  =  0.0 
+
+# CWRR_NKS_POWER ([-]) :  fitted value for relation log((n-n0)/(n_ref-n0))  	{}
+CWRR_NKS_POWER =  0.0 
+
+# CWRR_AKS_A0  ([1/mm]) :  fitted value for relation log((a-a0)/(a_ref-a0))  	{}
+CWRR_AKS_A0  =  0.0 
+
+# CWRR_AKS_POWER ([-]) :  fitted value for relation log((a-a0)/(a_ref-a0))  	{}
+CWRR_AKS_POWER =  0.0 
+
+# KFACT_DECAY_RATE ([1/m]) :  Factor for Ks decay with depth 	{}
+KFACT_DECAY_RATE =  2.0 
+
+# KFACT_STARTING_DEPTH ([m]) :  Depth for compacted value of Ks  	{}
+KFACT_STARTING_DEPTH =  0.3 
+
+# KFACT_MAX ([-]) :  Maximum Factor for Ks increase due to vegetation 	{}
+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 =  25.0  
+
+# FAST_TCST ([days]) :  Time constant for the fast reservoir  	{RIVER_ROUTING }
+FAST_TCST =  3.0  
+
+# STREAM_TCST ([days]) :  Time constant for the stream reservoir  	{RIVER_ROUTING}
+STREAM_TCST =  0.24 
+
+# 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  
+
+# XIOS_INTERPOLATION ([FLAG]) :  Actiave reading and intrepolation using XIOS 	{XIOS_ORCHIDEE_OK}
+XIOS_INTERPOLATION =  n 
+
Index: /branches/publications/ORCHIDEE-AFP/src_driver/AA_make
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/AA_make	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/AA_make	(revision 8430)
@@ -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-AFP/src_driver/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/AA_make.ldef	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/AA_make.ldef	(revision 8430)
@@ -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-AFP/src_driver/dim2_driver.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/dim2_driver.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/dim2_driver.f90	(revision 8430)
@@ -0,0 +1,1740 @@
+!  ==============================================================================================================================\n
+!  PROGRAM 	: driver
+! 
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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 time
+  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 :: lwdown_cons                !! Flag to conserve lwdown radiation from forcing
+  LOGICAL :: swdown_cons                !! Flag to conserve swdown radiation from forcing
+
+  ! 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
+
+  !Config Key   = LWDOWN_CONS
+  !Config Desc  = Conserve longwave downwelling radiation in the forcing
+  !Config Def   = n
+  !Config If    = 
+  !Config Help  = If LWDOWN_CONS=False a non conservative interpolation is used
+  !Config Units = [FLAG]
+  lwdown_cons = .FALSE.
+  CALL getin_p('LWDOWN_CONS', lwdown_cons)
+ 
+  !Config Key   = SWDOWN_CONS
+  !Config Desc  = Conserve shortwave downwelling radiation in the forcing
+  !Config Def   = LWDOWN_CONS
+  !Config If    = 
+  !Config Help  = If SWDOWN_CONS=False a non conservative interpolation is used
+  !Config Units = [FLAG]
+  swdown_cons = lwdown_cons
+  CALL getin_p('SWDOWN_CONS', swdown_cons)
+
+!=====================================================================
+!- 1.1 Initialize the driving variables. It essentialy gets the mode
+!-     used and the size of the driving variables.
+!=====================================================================
+  IF (printlev_loc>=4) 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>=4) 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) 
+!-
+  IF (printlev>=1) WRITE(numout,*) 'Information about forcing file : date0 ', date0, &
+       'iim, jjm, llm, tm',iim,jjm,llm,tm,' dt_force ',dt_force
+!-
+  CALL init_ioipsl_para
+!-
+  IF (printlev_loc>=4) 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)
+     IF (printlev_loc >= 1) WRITE(numout,*) 'Time step in forcing file: dt_force=',dt_force
+     IF (printlev_loc >= 1) WRITE(numout,*) 'Time step in sechiba component: dt_sechiba=',dt
+     IF (printlev_loc >= 1) 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>=4) 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>=4) 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>=4) 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>=4) 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>=4) 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
+
+     IF (printlev_loc >= 1) 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, lwdown_cons, swdown_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 >= 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
+  IF (printlev_loc >= 3) 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
+!-
+  IF (printlev_loc >= 1) THEN
+     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
+     WRITE(numout,*) '>> Time steps : true, forcing and restart : ', dt,dt_force,dt_rest
+  END IF
+
+  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
+
+
+!=====================================================================
+!- 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
+
+  !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
+
+
+!=====================================================================
+!- 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 to precribe atmosoheric CO2
+  !Config If    = [FORCE_CO2_VEG=y or Offline mode]
+  !Config Def   = 350.
+  !Config Help  = Used in offline mode or in coupled mode if FORCE_CO2_VEG=y
+  !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, lwdown_cons, swdown_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
+      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 )
+
+        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 >=3) 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
+      END IF
+
+      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-AFP/src_driver/forcesoil.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/forcesoil.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/forcesoil.f90	(revision 8430)
@@ -0,0 +1,643 @@
+! =================================================================================================================================
+! PROGRAM       : forcesoil
+!
+! CONTACT	: orchidee-help _at_ listes.ipsl.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-AFP/src_driver/forcing_tools.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/forcing_tools.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/forcing_tools.f90	(revision 8430)
@@ -0,0 +1,4462 @@
+!  ==============================================================================================================================\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
+  USE forcingdaily_tools
+  !
+  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
+  !
+  !
+  !
+  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_forgrid2d, forcing_printpoint_gen
+  END INTERFACE forcing_printpoint
+  !
+  INTERFACE forcing_getvalues
+     MODULE PROCEDURE forcing_getvalues1d, forcing_getvalues2d
+  END INTERFACE forcing_getvalues
+  !
+  ! 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), SAVE :: slab_size_max=80
+  !
+  ! 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, nbpoint_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
+  !
+  ! Descritpion of zoomed grid
+  !
+  LOGICAL, SAVE :: zoom_forcing = .FALSE.
+  INTEGER(i_std), SAVE :: iim_loc, jjm_loc, nbpoint_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 :: nbpoint_proc
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:) :: glolindex_proc
+  LOGICAL, SAVE :: landonly
+  !-
+  !- 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(:,:)    :: tairmax_slab, tairmin_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
+  !
+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, nbpoint_in, drvzoom_lon, drvzoom_lat, &
+       &                  kindex, nbindex_perproc, wunit, landonly_arg)
+    !
+    ! 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, nbpoint_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(nbpoint_in)
+    INTEGER(i_std), INTENT(in)            :: nbindex_perproc
+    INTEGER(i_std), OPTIONAL, INTENT(in)  :: wunit
+    LOGICAL, OPTIONAL, INTENT(in)         :: landonly_arg
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iim_tmp, jjm_tmp, nbpoint_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
+    !
+    ! Check optional arguments
+    !
+    ! The default behaviour is to provide only land points to the calling program.
+    ! But for forcing ocean model there is also the option to pass on land and ocean values.
+    ! When the grid is initialized landonly_tmp=.FALSE. has to be set to obtian this behaviour.
+    !
+    IF ( PRESENT(landonly_arg) ) THEN
+       landonly=landonly_arg
+    ELSE
+       landonly = .TRUE.
+    ENDIF
+    !
+    !Config Key  = FORCING_MEMORY
+    !Config Desc = Number of time steps of the forcing we will store in memory.
+    !Config Def  = 80
+    !Config Help = To reduce and optimise disk accesses more of the forcing can be loaded into
+    !Config        memory. With this parameter the amount of memory can be adjusted. Be carefull
+    !Config        as if you use too much memory the system will cick you out or slow down the
+    !Config        execution of your program. 
+    !
+    CALL getin('FORCING_MEMORY', slab_size_max)
+    !
+    ! How many files do we have to open ?
+    !
+    !
+    ! 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, nbpoint_tmp, .FALSE., landonly)
+       !
+       IF ( PRESENT(wunit) ) THEN
+          WRITE(wunit,*) "Getting the zoomed grid", nbpoint_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 ( nbpoint_loc .NE. nbpoint_in ) THEN
+          ! We trust the number of land points obtained from the gridfile. It has the land/sea mask.
+          nbpoint_loc = nbpoint_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 forcing_printdate(startdate, "--> Sarte Date in forcing_open")
+          CALL forcing_printdate(time_bounds(1,1,1), "--> Outer bound of forcing file.")
+          CALL forcing_printdate(time_bounds(nb_forcing_steps,1,2), "--> Last date to be simulated.")
+          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(nbpoint_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)
+    !
+    ! Number of points per processor
+    !
+    IF ( landonly ) THEN
+       nbpoint_proc = nbindex_perproc
+    ELSE
+       nbpoint_proc = nbpoint_glo
+    ENDIF
+    !
+    ! 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(nbpoint_proc))
+    IF ( .NOT. is_root_prc ) THEN
+       ALLOCATE(lon_loc(iim_loc,jjm_loc))
+       ALLOCATE(lat_loc(iim_loc,jjm_loc))
+       ALLOCATE(lindex_loc(nbpoint_loc)) 
+       ALLOCATE(mask_loc(iim_loc,jjm_loc))
+       ALLOCATE(area_loc(iim_loc,jjm_loc))
+       ALLOCATE(contfrac_loc(nbpoint_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
+    !
+    IF ( landonly ) THEN
+       CALL scatter(kindex, glolindex_proc)
+    ELSE
+       !
+       ! Build a simple indexing list as the one for land cannot be used.
+       !
+       ik=0
+       DO jj=1,jjm_loc
+          DO ii=1,iim_loc
+             ik=ik+1
+             glolindex_proc(ik) = ik
+          ENDDO
+       ENDDO
+    ENDIF
+    !
+    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_getvalues1d
+!!
+!>\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_getvalues1d(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", numout)
+       CALL forcing_printdate(time_tair(1), "Time of first temperature value", numout)
+       CALL forcing_printdate(timebnd_tair(slab_size,2), "End of time slab just read", numout)
+    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", numout)
+          CALL forcing_printdate(time_tair(1), "Time of first temperature value", numout)
+          CALL forcing_printdate(timebnd_tair(slab_size,2), "End of time slab just read", numout)
+       ENDIF
+    ENDIF
+    !
+    IF ( forcing_tstep_ave <= one_day/4.0) THEN
+       !
+       ! 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
+       !
+    ELSE IF (forcing_tstep_ave == one_day) THEN
+       !
+       ! If the forcing is daily we move to the module designed for these interpolations
+       !
+       CALL forcingdaily_gensubd(time_int, dt, iim_loc, jjm_loc, lon_loc, lat_loc, glolindex_proc, &
+            &                    nbpoint_proc, slab_size, time_tair, ztq_slab, zuv_slab, tair_slab, &
+            &                    tairmin_slab, tairmax_slab, qair_slab, rainf_slab, snowf_slab, &
+            &                    swdown_slab, lwdown_slab, u_slab, v_slab, ps_slab)
+       CALL forcingdaily_getvalues(time_int, dt, zlev_tq, zlev_uv, tair, qair, rainf, snowf, &
+            &                      swdown, lwdown, solarang, u, v, ps)
+       !
+    ELSE
+       !
+       ! Catch any forcing files not adapted to the interpolations available.
+       !
+       WRITE(numout,*) "#### Forcing time step is too long for a the foreseen interpolations"
+       WRITE(numout,*) "#### forcing_tstep_ave =", forcing_tstep_ave
+       CALL ipslerr (3,'forcing_getvalues1d', 'Forcing time step incompatible with implemented interpolations.',&
+            & "","")
+    ENDIF
+  END SUBROUTINE forcing_getvalues1d
+!!
+!!  =============================================================================================================================
+!! SUBROUTINE: forcing_getvalues2d
+!!
+!>\BRIEF   Gets the forcing data in 2D field 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_getvalues2d(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(:,:)
+    !
+    REAL(r_std) :: zzlev_tq(nbpoint_loc), zzlev_uv(nbpoint_loc)
+    REAL(r_std) :: ztair(nbpoint_loc), zqair(nbpoint_loc), zrainf(nbpoint_loc), zsnowf(nbpoint_loc)
+    REAL(r_std) :: zswdown(nbpoint_loc), zlwdown(nbpoint_loc), zsolarang(nbpoint_loc)
+    REAL(r_std) :: zu(nbpoint_loc), zv(nbpoint_loc), zps(nbpoint_loc)
+    INTEGER(i_std) :: i, j, k
+    !
+    CALL forcing_getvalues(time_int, dt, zzlev_tq, zzlev_uv, ztair, zqair, zrainf, zsnowf, zswdown, zlwdown, zsolarang, zu, zv, zps)
+    !
+    k = 0
+    DO j=1,jjm_loc
+       DO i=1,iim_loc
+          k = k + 1
+          zlev_tq(i,j) = zzlev_tq(k)
+          zlev_uv(i,j) = zzlev_uv(k)
+          tair(i,j) = ztair(k)
+          qair(i,j) = zqair(k)
+          rainf(i,j) = zrainf(k)
+          snowf(i,j) = zsnowf(k)
+          swdown(i,j) = zswdown(k)
+          lwdown(i,j) = zlwdown(k)
+          solarang(i,j) = zsolarang(k)
+          u(i,j) = zu(k)
+          v(i,j) = zv(k)
+          ps(i,j) = zps(k)
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE forcing_getvalues2d
+    
+!!  =============================================================================================================================
+!! 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, ALLOCATABLE, DIMENSION(:) :: mask
+    !
+    ! Shift the input dates in order to gain in precision for the calculations 
+    !
+    IF ( .NOT. ALLOCATED(mask) ) THEN
+       ALLOCATE(mask(slab_size_max))
+       mask(:) = .FALSE.
+    ENDIF
+    !
+    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, nbpoint_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, ALLOCATABLE, DIMENSION(:) :: mask
+    !
+    ! Create a mask so that MINLOC does not look outside of the valid interval of time_central
+    !
+    IF ( .NOT. ALLOCATED(mask) ) THEN
+       ALLOCATE(mask(slab_size_max))
+       mask(:) = .TRUE.
+    ENDIF
+    !
+    ! 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)
+    !
+    ! 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, nbpoint_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
+    !
+    LOGICAL, SAVE :: first_call_spreadprec=.TRUE.
+    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, ALLOCATABLE, DIMENSION(:) :: mask
+    !
+    !
+    IF ( .NOT. ALLOCATED(mask) ) THEN
+       ALLOCATE(mask(slab_size_max))
+       mask(:) = .FALSE.
+    ENDIF
+    !
+    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, nbpoint_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
+    !
+    LOGICAL, SAVE        :: first_call_solarint=.TRUE.
+    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, ALLOCATABLE, DIMENSION(:) :: mask
+    !
+    !
+    IF ( .NOT. ALLOCATED(mask) ) THEN
+       ALLOCATE(mask(slab_size_max))
+       mask(:) = .FALSE.
+    ENDIF
+    
+    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, nbpoint_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(:,:)    :: tairmin_full, tairmax_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(nbpoint_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 ( forcing_tstep_ave >= one_day/4.0) THEN
+       IF ( .NOT. ALLOCATED(tairmax_slab) ) ALLOCATE(tairmax_slab(nbpoint_proc,slab_size))
+       IF ( .NOT. ALLOCATED(tairmin_slab) ) ALLOCATE(tairmin_slab(nbpoint_proc,slab_size))
+    ENDIF
+    !
+    IF ( .NOT. ALLOCATED(qair_slab) ) ALLOCATE(qair_slab(nbpoint_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(nbpoint_proc,slab_size))
+    IF ( .NOT. ALLOCATED(snowf_slab) ) ALLOCATE(snowf_slab(nbpoint_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(nbpoint_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(nbpoint_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(nbpoint_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(nbpoint_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(nbpoint_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(nbpoint_proc,slab_size))
+    IF ( .NOT. ALLOCATED(zuv_slab) ) ALLOCATE(zuv_slab(nbpoint_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(nbpoint_loc,slab_size))
+       IF ( forcing_tstep_ave >= one_day/4.0) THEN
+          ALLOCATE(tairmax_full(nbpoint_loc,slab_size))
+          ALLOCATE(tairmin_full(nbpoint_loc,slab_size))
+       ENDIF
+       ALLOCATE(qair_full(nbpoint_loc,slab_size))
+       ALLOCATE(rainf_full(nbpoint_loc,slab_size))
+       ALLOCATE(snowf_full(nbpoint_loc,slab_size))
+       ALLOCATE(swdown_full(nbpoint_loc,slab_size))
+       ALLOCATE(lwdown_full(nbpoint_loc,slab_size))
+       ALLOCATE(u_full(nbpoint_loc,slab_size))
+       ALLOCATE(v_full(nbpoint_loc,slab_size))
+       ALLOCATE(ps_full(nbpoint_loc,slab_size))
+       ALLOCATE(ztq_full(nbpoint_loc,slab_size))
+       ALLOCATE(zuv_full(nbpoint_loc,slab_size))
+       !
+       CALL forcing_readslab_root(time_int, &
+            &                     tair_full, tairmax_full, tairmin_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))
+       IF ( forcing_tstep_ave >= one_day/4.0) THEN
+          ALLOCATE(tairmax_full(1,1))
+          ALLOCATE(tairmin_full(1,1))
+       ENDIF
+       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
+    !
+    IF ( landonly ) THEN
+       CALL scatter(tair_full, tair_slab)
+       IF ( forcing_tstep_ave >= one_day/4.0) THEN
+          CALL scatter(tairmax_full, tairmax_slab)
+          CALL scatter(tairmin_full, tairmin_slab)
+       ENDIF
+       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)
+    ELSE
+       tair_slab(:,:) = tair_full(:,:)
+       IF ( forcing_tstep_ave >= one_day/4.0) THEN
+          tairmax_slab(:,:) = tairmax_full(:,:)
+          tairmin_slab(:,:) = tairmin_full(:,:)
+       ENDIF
+       qair_slab(:,:) = qair_full(:,:)
+       rainf_slab(:,:) = rainf_full(:,:)
+       snowf_slab(:,:) = snowf_full(:,:)
+       swdown_slab(:,:) = swdown_full(:,:)
+       lwdown_slab(:,:) = lwdown_full(:,:)
+       u_slab(:,:) = u_full(:,:)
+       v_slab(:,:) = v_full(:,:)
+       ps_slab(:,:) = ps_full(:,:)
+       ztq_slab(:,:) = ztq_full(:,:)
+       zuv_slab(:,:) = zuv_full(:,:)
+    ENDIF
+    !
+    ! Clean-up to free the memory on the root processor.
+    !
+    IF ( ALLOCATED(tair_full) ) DEALLOCATE(tair_full)
+    IF ( ALLOCATED(tairmax_full) ) DEALLOCATE(tairmax_full)
+    IF ( ALLOCATED(tairmin_full) ) DEALLOCATE(tairmin_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, tairmax, tairmin, 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(:,:), tairmax(:,:), tairmin(:,:)
+    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
+    !
+    LOGICAL, SAVE :: first_call_readslab=.TRUE.
+    !
+    ALLOCATE(time_tmp(slab_size,nbtax))
+    ALLOCATE(rau(nbpoint_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
+          !
+          ! 
+          !
+          IF ( forcing_tstep_ave >= one_day/4.0) THEN
+             CALL forcing_varforslab(if, "Tairmax", nctstart, nctcount, inslabpos, tairmax, cellmethod)
+             CALL forcing_varforslab(if, "Tairmin", nctstart, nctcount, inslabpos, tairmin, cellmethod)
+          ENDIF
+          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)
+          !
+          ! Verify on Tair that we have a credible field.
+          !
+          IF (   MINVAL(tair(:,inslabpos:inslabpos+nctcount-1)) < 100.0 .OR. &
+               & MAXVAL(tair(:,inslabpos:inslabpos+nctcount-1)) > 500.0 ) THEN
+             WRITE(*,*) "ERROR on range of Tair : ", MINVAL(tair(:,inslabpos:inslabpos+nctcount-1)), &
+                  &                                  MAXVAL(tair(:,inslabpos:inslabpos+nctcount-1))
+             CALL ipslerr(3, 'forcing_readslab_root','The air temperature is not in a credible range.', &
+                  &         'Please verify your forcing file.','Are variables for all points to be simulated ?')
+          ENDIF
+          !
+          ! 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
+             DO it=inslabpos,inslabpos+nctcount-1
+                rau(:,it) = ps(:,it)/(cte_molr*tair(:,it))
+                ztq(:,it) = (ps(:,it) - (zhybrid_a + zhybrid_b*ps(:,it)))/(rau(:,it) * cte_grav)
+             ENDDO
+          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
+                DO it=inslabpos,inslabpos+nctcount-1
+                   rau(:,it) = ps(:,it)/(cte_molr*tair(:,it))
+                   zuv(:,it) = (ps(:,it) - (zhybriduv_a + zhybriduv_b*ps(:,it)))/(rau(:,it) * cte_grav)
+                ENDDO
+             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_forgrid2d
+!!
+!>\BRIEF     Together with the date print some sample values. Useful for checking the forcing. 
+!!
+!! DESCRIPTION:	  
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE forcing_printpoint_forgrid2d(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
+    INTEGER(i_std), DIMENSION(1) :: i,j
+    !
+    ! 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))
+    !
+    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)), i(1), j(1), var(i(1),j(1)), message
+    
+  END SUBROUTINE forcing_printpoint_forgrid2d
+
+!!  =============================================================================================================================
+!! 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, nbpoint_tmp, closefile, landonly_arg)
+    !
+    ! 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, nbpoint_tmp
+    LOGICAL, INTENT(in)           :: closefile
+    LOGICAL, OPTIONAL, INTENT(in) :: landonly_arg
+    !
+    ! 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
+    !
+    ! The default behaviour is to provide only land points to the calling program.
+    ! But for forcing ocean model there is also the option to pass on land and ocean values.
+    ! When the grid is initialized landonly_tmp=.FALSE. has to be set to obtian this behaviour.
+    !
+    IF ( PRESENT(landonly_arg) ) THEN
+       landonly=landonly_arg
+    ELSE
+       landonly=.TRUE.
+    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(lowercase(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("longitude")
+             CALL forcing_checkdim(iff, filename, iim_glo, lon_id, lll, iv)
+          CASE("latitude")
+             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
+             ! No missing_value found, try to read _FillValue instead
+             iret = NF90_GET_ATT(force_id(1), iv, "_FillValue", contfrac_missing)
+             IF (iret /= NF90_NOERR) THEN
+                WRITE(*,*) TRIM(nf90_strerror(iret))
+                WRITE(*,*) " >> No _FillValue or missing_value found for contfrac"
+                contfrac_missing=0.0
+             END IF
+          ENDIF
+       ENDIF
+       !
+       ! Find the test variable
+       !
+       IF ( INDEX(lowercase(varname), TRIM(lowercase(testvarname))) > 0 .AND. &
+            & LEN_TRIM(varname) == LEN_TRIM(testvarname)) THEN
+          testvar_id = iv
+          iret = NF90_GET_ATT(force_id(1), iv, "missing_value", testvar_missing)
+          IF (iret /= NF90_NOERR) THEN
+             ! No missing_value found, try to read _FillValue instead
+             iret = NF90_GET_ATT(force_id(1), iv, "_FillValue", testvar_missing)
+             IF (iret /= NF90_NOERR) THEN
+                WRITE(*,*) TRIM(nf90_strerror(iret))
+                WRITE(*,*) " >> No _FillValue or missing_value found for variable=",varname
+                testvar_missing=-1
+             END IF
+          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 .OR. &
+          &  INDEX(lowercase(units),'days 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 ( landonly ) 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)
+          nbpoint_glo = nbland_glo
+       ELSE
+          WRITE(*,*) "forcing_tools cannot provide data over ocean points as the"
+          WRITE(*,*) "data in the file is compressed by gathering land points."
+          WRITE(*,*) "Fatal error"
+          CALL ipslerr (3,'forcing_getglogrid',"forcing_tools cannot provide data over ocean points as the", &
+               &                               "data in the file is compressed by gathering land points.", " ")
+       ENDIF
+    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 ( landonly ) THEN
+          nbpoint_glo = nbland_glo
+          IF ( .NOT. ALLOCATED(lindex_glo)) ALLOCATE(lindex_glo(nbpoint_glo))
+          IF ( .NOT. ALLOCATED(contfrac_glo)) ALLOCATE(contfrac_glo(nbpoint_glo))
+          IF ( .NOT. ALLOCATED(testvar)) ALLOCATE(testvar(nbpoint_glo))
+          IF ( contfrac_id > 0 ) THEN
+             CALL forcing_buildindex(contfrac2d, contfrac_missing, landonly, lindex_glo, contfrac_glo)
+             CALL forcing_reindex(iim_glo, jjm_glo, testvar2d, nbland_glo, testvar, lindex_glo)
+          ELSE
+             CALL forcing_buildindex(testvar2d, testvar_missing, landonly, lindex_glo, testvar)
+             contfrac_glo(:) = 1.0
+          ENDIF
+       ELSE
+          nbpoint_glo = iim_glo*jjm_glo
+          IF ( .NOT. ALLOCATED(lindex_glo)) ALLOCATE(lindex_glo(nbpoint_glo))
+          IF ( .NOT. ALLOCATED(contfrac_glo)) ALLOCATE(contfrac_glo(nbpoint_glo))
+          IF ( .NOT. ALLOCATED(testvar)) ALLOCATE(testvar(nbpoint_glo))
+          IF ( contfrac_id > 0 ) THEN
+             CALL forcing_buildindex(contfrac2d, contfrac_missing, landonly, lindex_glo, contfrac_glo)
+             CALL forcing_reindex(iim_glo, jjm_glo, testvar2d, nbland_glo, testvar, lindex_glo)
+          ELSE
+             CALL forcing_buildindex(testvar2d, testvar_missing, landonly, lindex_glo, testvar)
+             contfrac_glo(:) = 1.0
+          ENDIF
+       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
+    nbpoint_tmp = nbpoint_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, landonly, 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
+    LOGICAL, INTENT(in)     :: landonly
+    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 ( landonly ) THEN
+             IF ( var2d(i,j) /= var_missing ) THEN
+                k = k + 1
+                lindex(k) = (j-1)*iim_glo+i 
+                var(k) = var2d(i,j)
+             ENDIF
+          ELSE
+             ! When we take all point, no test is performed.
+             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 = (/nbpoint_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, nbpoint_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 = (/nbpoint_glo,1,0/)
+    ELSE IF ( it == 3 ) THEN
+       start = (/1,1,1/)
+       count = (/nbpoint_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(nbpoint_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,nbpoint_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(nbpoint_glo))
+       !
+       CALL forcing_reindex(nbpoint_glo, testvar, nbpoint_glo, testvar_reind, reindex_glo)
+       !
+       CALL forcing_writetestvar("forcing_mask_glo.nc", iim_glo, jjm_glo, nbpoint_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)
+    !
+    !
+    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
+    !
+    nbpoint_loc = SUM(mask_loc)
+    IF ( .NOT. zoom_forcing .AND. nbpoint_loc .NE. nbpoint_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(nbpoint_loc))
+    IF ( .NOT. ALLOCATED(reindex_loc)) ALLOCATE(reindex_loc(nbpoint_loc))
+    IF ( .NOT. ALLOCATED(contfrac_loc)) ALLOCATE(contfrac_loc(nbpoint_loc))
+    !
+    IF ( .NOT. ALLOCATED(reindex2d_loc)) ALLOCATE(reindex2d_loc(nbpoint_loc,2))
+    IF ( .NOT. ALLOCATED(index_glotoloc)) ALLOCATE(index_glotoloc(nbpoint_glo))
+    IF ( .NOT. ALLOCATED(lalo)) ALLOCATE(lalo(nbpoint_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
+    !
+    !
+    nbland_loc = SUM(contfrac_loc)
+    !
+    !
+    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(nbpoint_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, nbpoint_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, nbpoint_loc, zoomedvar, reindex2d_loc)
+          !
+       ENDIF
+       !
+       CALL forcing_writetestvar("forcing_mask_loc.nc", iim_loc, jjm_loc, nbpoint_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.
+          varuv_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.
+       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(nbpoint_loc)
+    REAL(r_std), INTENT(out) :: contfrac(nbpoint_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, ymd, hms
+  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
+        ELSE IF ( INDEX(lowercase(tmpatt),'days since') > 0) THEN
+           time_id(iff,tcnt)=iv
+           tcnt=tcnt+1
+           convtosec(iff)=one_day
+        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)))
+        ymd=TRIM(timestamp(1:INDEX(timestamp,' ')))
+        hms=TRIM(timestamp(INDEX(timestamp,' ')+1:LEN_TRIM(timestamp)))
+        !
+        ! First extral the information from the date string
+        !
+        READ(ymd(1:INDEX(ymd,'-')-1),'(I4)') year0
+        ymd=TRIM(ymd(INDEX(ymd,'-')+1:LEN_TRIM(ymd)))
+        READ(ymd(1:INDEX(ymd,'-')-1),'(I2)') month0
+        ymd=TRIM(ymd(INDEX(ymd,'-')+1:LEN_TRIM(ymd)))
+        READ(ymd,'(I2)') day0
+        !
+        ! Now extract from the time string
+        !
+        READ(hms(1:INDEX(hms,':')-1),'(I2)') hours0
+        hms=TRIM(hms(INDEX(hms,':')+1:LEN_TRIM(hms)))
+        READ(hms(1:INDEX(hms,':')-1),'(I2)') minutes0
+        hms=TRIM(hms(INDEX(hms,':')+1:LEN_TRIM(hms)))
+        READ(hms,'(I2)') seci
+        !
+        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(nbpoint_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, nbpoint_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, nbpoint_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
+
+END MODULE forcing_tools
Index: /branches/publications/ORCHIDEE-AFP/src_driver/forcingdaily_tools.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/forcingdaily_tools.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/forcingdaily_tools.f90	(revision 8430)
@@ -0,0 +1,655 @@
+!  ==============================================================================================================================\n
+!  MODULE forcingdaily_tools : The general idea of this module is to re-generate a diurnal cycle of forcing variables based
+!                              on the daily mean values and Tairmin and Tairmax. The approach is to generate a temporal sub-domain
+!                              of size "szsbd" which will correspond to "nbdays" days. Thus "nbdays" daily means will be used
+!                              to regenerate the diurnal cycles. Doing more than one day allows to use higher order interpolations
+!                              in case it is needed and avoid discontinuities. This process is performed by forcingdaily_gensubd when
+!                              ever we come to a new day. The the subroutine forcingdaily_getvalues will extract from the "nbdays" of
+!                              reconstructed diurnal cycle the values ORCHIDEE needs.
+!                              For most variables we have a specific subroutine to re-generate the diurnal cycle with some specific
+!                              parameters which allow to adjust the process.
+!
+!               forcingdaily_gensubd :
+!               forcingdaily_getvalues :
+!
+!  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 forcingdaily_tools
+  !
+  USE defprec
+  USE netcdf
+  !
+  USE ioipsl
+  USE constantes
+  USE solar
+  !
+  USE mod_orchidee_para
+  !
+  IMPLICIT NONE
+  !
+  PRIVATE
+  PUBLIC :: forcingdaily_gensubd, forcingdaily_getvalues
+  !
+  ! 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), SAVE                              :: current_day = -1
+  REAL(r_std), PARAMETER                            :: dusk_angle = 0.01
+  INTEGER(i_std), PARAMETER                         :: nbdays = 3
+  INTEGER(i_std), PARAMETER                         :: spreadprec = 7200    !! Time over which the precipitation should be distributed (in sec.)
+  REAL(r_std), PARAMETER                            :: convprec_temp = 20.0 !! Temperature above which all precipitation is supposed to be convective.
+                                                                            !! i.e. rainfall occurs only over spreadprec. Below rainfall will last longer.
+  INTEGER(i_std), PARAMETER                         :: tmaxshift = 10800    !! How long after the solar noon should Tairmax occus ? Time in seconds. 
+  INTEGER(i_std), SAVE                              :: seed = 7865439    
+  !
+  INTEGER(i_std), SAVE                              :: szsubd
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)      :: time_subd
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: tair_subd, qair_subd
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: ztq_subd, zuv_subd
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: rainf_subd, snowf_subd
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: solarang_subd, swdown_subd, lwdown_subd
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)    :: u_subd, v_subd, ps_subd
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)  :: sinangles
+  INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: idusk, irise, inoon
+  !
+CONTAINS
+!!
+!! =============================================================================================================================
+!! SUBROUTINE: forcingdaily_getval
+!!
+!!
+!>\BRIEF        Extracts the forcing values needed by ORCHIDEE from teh re-generated diurnal cycles.
+!!
+!! DESCRIPTION: As we are in a re-geneted diurnal cycle case, not a lot of precaution is taken to identify the value to be
+!!              used for the next integration interval of ORCHIDEE. Simply the values located closest to the middle of the
+!!              integration interval. This could be improved based on what is coded in forcing_tools.f90.     
+!!  
+!! \n
+!_ ==============================================================================================================================
+!  
+  SUBROUTINE forcingdaily_getvalues(time_int, dt, ztq, zuv, 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) :: ztq(:), zuv(:)
+    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) :: imin(1), i
+    REAL(r_std)    :: tloc
+    !
+    tloc = (time_int(1)+time_int(2))/2.0
+    imin = MINLOC(ABS((tloc - (time_subd(:)+current_day))))
+    !
+    !
+    tair(:) = tair_subd(:,imin(1))
+    qair(:) = qair_subd(:,imin(1))
+    rainf(:) = rainf_subd(:,imin(1))
+    snowf(:) = snowf_subd(:,imin(1))
+    swdown(:) = swdown_subd(:,imin(1))
+    lwdown(:) = lwdown_subd(:,imin(1))
+    solarang(:) = solarang_subd(:,imin(1))
+    ztq(:) = ztq_subd(:,imin(1))
+    zuv(:) = zuv_subd(:,imin(1))
+    u(:) = u_subd(:,imin(1))
+    v(:) = v_subd(:,imin(1))
+    ps(:) = ps_subd(:,imin(1))
+    !
+  END SUBROUTINE forcingdaily_getvalues
+!!
+!! =============================================================================================================================
+!! SUBROUTINE: forcingdaily_gensubd
+!!
+!!
+!>\BRIEF       generates the sub-diurnal cycle for a number of days around the current time step of the ORCHIDEE simulation. 
+!!
+!! DESCRIPTION: This routine only works when we start a new day so that not too much work is done. At each new day first the
+!!              the diurnal evolution of the solar angle is computed and then from there all the rest is derived. For swdown
+!!              it is a trivial process but for the other variables more complex procedures are used. For those variables
+!!              nothing could be invented the daily mean value is places et the center of the day and a linear interpolation is
+!!              used.  
+!!  
+!! \n
+!_ ==============================================================================================================================
+!
+  SUBROUTINE forcingdaily_gensubd(time_int, dt, iim, jjm, lon, lat, gindex_proc, &
+       &                          szdom, szslab, time_slab, ztq, zuv, tair, tairmin, tairmax, &
+       &                          qair, rainf, snowf, swdown, lwdown, 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)
+    INTEGER(i_std), INTENT(in) :: szdom, szslab
+    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
+    INTEGER(i_std), INTENT(in) :: gindex_proc(szdom)
+    REAL(r_std), INTENT(in)    :: time_slab(szslab)
+    REAL(r_std), INTENT(in)    :: ztq(szdom,szslab), zuv(szdom,szslab)
+    REAL(r_std), INTENT(in)    :: tair(szdom,szslab), tairmin(szdom,szslab), tairmax(szdom,szslab)
+    REAL(r_std), INTENT(in)    :: qair(szdom,szslab), rainf(szdom,szslab), snowf(szdom,szslab)
+    REAL(r_std), INTENT(in)    :: swdown(szdom,szslab), lwdown(szdom,szslab)
+    REAL(r_std), INTENT(in)    :: u(szdom,szslab), v(szdom,szslab), ps(szdom,szslab)
+    !
+    ! LOCAL
+    !
+    REAL(r_std)       :: tloc
+    INTEGER(i_std)    :: it, i, ist, imin(1), imax(1), tmin(1), iday
+    INTEGER(i_std)    :: stpday, half_subd
+    REAL(r_std)       :: julian
+    !
+    ! Set date to middle of requested interval.
+    !
+    tloc = (time_int(1)+time_int(2))/2.0
+    !
+    IF (INT(tloc) .NE. current_day) THEN
+       !
+       ! Save the date on which the 3 days are centered
+       !
+       current_day = INT(tloc)
+       !
+       ! The sub-diurnal cycle needs to be generated for the 3 days around the current time step.
+       ! Allocate memory needed.
+       !
+       IF ( .NOT. ALLOCATED(time_subd) ) THEN
+          !
+          szsubd=INT(nbdays*one_day/dt)
+          CALL random_seed()
+          !
+          ALLOCATE(time_subd(szsubd))
+          ALLOCATE(tair_subd(szdom,szsubd))
+          ALLOCATE(qair_subd(szdom,szsubd))
+          ALLOCATE(rainf_subd(szdom,szsubd))
+          ALLOCATE(snowf_subd(szdom,szsubd))
+          ALLOCATE(swdown_subd(szdom,szsubd))
+          ALLOCATE(lwdown_subd(szdom,szsubd))
+          ALLOCATE(solarang_subd(szdom,szsubd))
+          ALLOCATE(ztq_subd(szdom,szsubd))
+          ALLOCATE(zuv_subd(szdom,szsubd))
+          ALLOCATE(u_subd(szdom,szsubd))
+          ALLOCATE(v_subd(szdom,szsubd))
+          ALLOCATE(ps_subd(szdom,szsubd))
+          ALLOCATE(sinangles(iim,jjm,szsubd))
+          ALLOCATE(idusk(szdom,nbdays))
+          ALLOCATE(irise(szdom,nbdays))
+          ALLOCATE(inoon(szdom,nbdays))
+       ENDIF
+       !
+       ! Number of sub-diurnal time steps per day.
+       ! half_subd : number of days on either side of current date to be added.
+       stpday = NINT(REAL(szsubd/nbdays))
+       half_subd=INT(nbdays/2.0)
+       !
+       ! Generate time axis for the sub-diurnal domain, over the number of days we have (nbdays)
+       !
+       DO it=1,szsubd
+          ! Time will be relative to the day at which we are being called.
+          time_subd(it) = ((-half_subd*one_day)+(it-0.5)*dt)/one_day
+       ENDDO
+       !
+       CALL forcingdaily_solar(tloc, iim, jjm, lon, lat, gindex_proc, &
+            &                       szdom, szslab, time_slab, swdown, &
+            &                       szsubd, swdown_subd, sinangles, irise, inoon, idusk)
+       !
+       ! Temperature
+       !
+       CALL forcingdaily_tair(tloc, dt, szdom, nbdays, szslab, time_slab, tairmin, tairmax, &
+            &                 irise, inoon, szsubd, tair_subd)
+       !
+       ! LWdown
+       !
+       CALL forcingdaily_lwdown(tloc, dt, szdom, szslab, time_slab, &
+            &                   lwdown, szsubd, stpday, lwdown_subd)
+       !
+       ! Precipitation
+       !
+       CALL forcingdaily_precip(tloc, dt, iim, jjm, lon, lat, gindex_proc, &
+            &                       szdom, szslab, time_slab, rainf, snowf, tair, &
+            &                       szsubd, rainf_subd, snowf_subd)
+       !
+       ! Qair, U, V, PS
+       !
+       qair_subd(:,:) = undef_sechiba
+       ztq_subd(:,:) = undef_sechiba
+       zuv_subd(:,:) = undef_sechiba
+       u_subd(:,:) = undef_sechiba
+       v_subd(:,:) = undef_sechiba
+       ps_subd(:,:) = undef_sechiba
+       DO i=1,szdom
+          DO iday=1,nbdays
+             ist = (iday-1)*stpday+stpday/2
+             julian = INT(time_subd(ist) + current_day)+0.5
+             imin = MINLOC(ABS((julian - time_slab(1:szslab))))
+             qair_subd(i,ist) = qair(i,imin(1))
+             ztq_subd(i,ist) = ztq(i,imin(1))
+             zuv_subd(i,ist) = zuv(i,imin(1))
+             u_subd(i,ist) = u(i,imin(1))
+             v_subd(i,ist) = v(i,imin(1))
+             ps_subd(i,ist) = ps(i,imin(1))
+          ENDDO
+       ENDDO
+       CALL forcingdaily_linint(szdom, szsubd, nbdays, qair_subd)
+       CALL forcingdaily_linint(szdom, szsubd, nbdays, ztq_subd)
+       CALL forcingdaily_linint(szdom, szsubd, nbdays, zuv_subd)
+       CALL forcingdaily_linint(szdom, szsubd, nbdays, u_subd)
+       CALL forcingdaily_linint(szdom, szsubd, nbdays, v_subd)
+       CALL forcingdaily_linint(szdom, szsubd, nbdays, ps_subd)
+    ELSE
+       ! Nothing to do as the sub-diurnal cycle has already been generated
+    ENDIF
+  END SUBROUTINE forcingdaily_gensubd
+!!
+!! =============================================================================================================================
+!! SUBROUTINE: forcingdaily_linint
+!!
+!>\BRIEF        Does a linear interpolation of the variables already placed in the variable.
+!!
+!! DESCRIPTION: It will replace the undefined values (x >= undef_sechiba) by the interpolated value. Before entering this
+!!              subroutine all time series need to be set to undef_sechiba with only the point between the interpolation should
+!!              be applied filled with actual values.
+!!  
+!! \n
+!_ ==============================================================================================================================
+!
+  SUBROUTINE forcingdaily_linint(xsz, tsz, nbdays, x)
+    !!
+    !! Arguments
+    !!
+    INTEGER(i_std), INTENT(in)    :: xsz, tsz, nbdays
+    REAL(r_std), INTENT(inout)    :: x(xsz,tsz)
+    !!
+    !! Local
+    !!
+    INTEGER(i_std) :: ii, it, i
+    INTEGER(i_std) :: find, nind, sind
+    REAL(r_std)    :: fval, nval, del
+    !!
+    !
+    DO ii=1,xsz
+       !
+       find = -1
+       fval = undef_sechiba
+       nind = 1
+       nval = undef_sechiba
+       !
+       DO WHILE (nind < tsz)
+          !
+          ! Look for the next defined value
+          !
+          DO WHILE (nval >= undef_sechiba .AND. nind < tsz)
+             IF (x(ii,nind) < undef_sechiba) THEN
+                nval=x(ii,nind)
+             ELSE
+                nind=nind+1
+             ENDIF
+             IF (nind >= tsz) THEN
+                nval = undef_sechiba
+                nind = tsz
+             ENDIF
+          ENDDO
+          !
+          ! Do the filling or interpolation between find and nind
+          !
+          IF ( find < 0 ) THEN
+             DO i=1,nind
+                x(ii,i) = nval
+             ENDDO
+          ELSE IF (nind == tsz) THEN
+             DO i=find,tsz
+                x(ii,i) = fval
+             ENDDO
+          ELSE
+             del = (nval-fval)/(nind-find)
+             DO i=find,nind
+                x(ii,i) = fval+del*(i-find)
+             ENDDO
+          ENDIF
+          !
+          ! Move information to first index
+          !
+          find = nind
+          fval = nval
+          nval = undef_sechiba
+          nind = nind+1
+       ENDDO
+    ENDDO
+  END SUBROUTINE forcingdaily_linint
+!!
+!! =============================================================================================================================
+!! SUBROUTINE: forcingdaily_solar
+!!
+!!
+!>\BRIEF        Computes the diurnal cycle of the solarangle and incident solar radiation.
+!!
+!! DESCRIPTION: This is very close to what is done in forcing_tools.f90 for the SWdown interpolation. The added code here
+!!              is to compute the time indicis of sun rise, noon and sun set. These will be important point in the
+!!              re-generation of the diurnal cycles.
+!!  
+!! \n
+!_ ==============================================================================================================================
+!  
+  SUBROUTINE forcingdaily_solar(tloc, iim, jjm, lon, lat, gindex_proc, &
+       &                        szdom, szslab, time_slab, swdown_loc, &
+       &                        szsubd, swdown_subd, sinangles, irise, inoon, idusk)
+    !
+    ! Arguments
+    !
+    REAL(r_std), INTENT(in)    :: tloc
+    INTEGER(i_std), INTENT(in) :: szdom, szslab
+    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
+    INTEGER(i_std), INTENT(in) :: gindex_proc(szdom)
+    REAL(r_std), INTENT(in)    :: time_slab(szslab)
+    REAL(r_std), INTENT(in)    :: swdown_loc(szdom,szslab)
+    INTEGER(i_std), INTENT(in) :: szsubd
+    REAL(r_std), INTENT(out)   :: swdown_subd(szdom,szsubd)
+    REAL(r_std), INTENT(out)   :: sinangles(iim,jjm,szsubd)
+    INTEGER(i_std), INTENT(out)   :: idusk(szdom,nbdays)
+    INTEGER(i_std), INTENT(out)   :: irise(szdom,nbdays)
+    INTEGER(i_std), INTENT(out)   :: inoon(szdom,nbdays)    
+    !
+    ! Local
+    !
+    REAL(r_std)       :: cval, lval
+    INTEGER(i_std)    :: it, ii, jj, i, ist, imin(1), imax(1), tmin(1), iday
+    INTEGER(i_std)    :: year, month, day, hours, minutes
+    INTEGER(i_std)    :: stpday, half_subd
+    REAL(r_std)       :: sec, julian
+    REAL(r_std), SAVE :: solaryearstart
+    REAL(r_std)       :: sinang(iim,jjm), mean_sinang(iim,jjm,nbdays)
+    INTEGER(i_std)    :: nbval(nbdays)
+    LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:) :: mask
+    !
+    ! Allocate memory
+    !
+    IF ( .NOT. ALLOCATED(mask) ) THEN
+       ALLOCATE(mask(szsubd))
+    ENDIF
+    !
+    ! Get some basic dates and dimensions
+    !
+    stpday = NINT(REAL(szsubd/nbdays))
+    half_subd=INT(nbdays/2.0)
+    CALL ju2ymds (tloc, year, month, day, sec)
+    CALL ymds2ju (year, 1, 1, 0.0, solaryearstart)
+    !
+    mean_sinang(:,:,:) = 0.0
+    nbval(:) = 0
+    !
+    ! Compute all solar angles
+    !
+    DO it=1,szsubd
+       julian=time_subd(it) + current_day
+       iday = INT(time_subd(it)+(nbdays-half_subd))
+       CALL solarang (julian, solaryearstart, iim, jjm, lon, lat, sinang)
+       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,iday) = mean_sinang(ii,jj,iday)+sinang(ii,jj)
+          ENDDO
+       ENDDO
+       nbval(iday) = nbval(iday)+1
+       !
+       sinangles(:,:,it) = sinang(:,:)
+       !
+    ENDDO
+    DO it=1,nbdays
+       mean_sinang(:,:,it) = mean_sinang(:,:,it)/nbval(it)
+    ENDDO
+    !
+    tmin = MINLOC(ABS((tloc-current_day)-time_subd(1:szsubd)))
+    imin = MINLOC(ABS((tloc - time_slab(1:szslab))))
+    sinang(:,:) = sinangles(:,:,tmin(1))
+    !
+    ! Set default values for irise, inoon and idusk so that in polar
+    ! regions we are not left with these indicis outside of range.
+    ! These values only matter when the sun never rises (sinangles < dusk_angle).
+    !
+    DO iday=1,nbdays
+       irise(:,iday) = (iday-1)*stpday + INT(stpday/3)
+       inoon(:,iday) = (iday-1)*stpday + INT(stpday/2)
+       idusk(:,iday) = (iday-1)*stpday + INT(stpday/2) + INT(stpday/3)
+    ENDDO
+    !
+    DO it=1,szsubd
+       DO i=1,szdom
+          !
+          iday = INT(time_subd(it)+(nbdays-half_subd))
+          ! Put Julian date to mid-day of current day
+          julian = INT(time_subd(it) + current_day)+0.5
+          imin = MINLOC(ABS((julian - time_slab(1:szslab))))
+          !
+          jj = ((gindex_proc(i)-1)/iim)+1
+          ii = (gindex_proc(i)-(jj-1)*iim)
+          !
+          IF ( mean_sinang(ii,jj,iday) > zero ) THEN
+             swdown_subd(i,it) = swdown_loc(i,imin(1))*sinangles(ii,jj,it)/mean_sinang(ii,jj,iday)
+          ELSE
+             swdown_subd(i,it) = zero
+          ENDIF
+          !
+          !
+          solarang_subd(i,it) = sinangles(ii,jj,it)
+          !
+          lval = sinangles(ii,jj,MAX(it-1,1))
+          cval = sinangles(ii,jj,it)
+          IF ( lval .LE.  dusk_angle .AND. cval .GT. dusk_angle ) THEN
+             irise(i,iday) = it
+          ENDIF
+          IF ( lval .GT. dusk_angle .AND. cval .LE. dusk_angle ) THEN
+             idusk(i,iday) = it
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Position the solar noon in each day
+    !
+    DO i=1,szdom
+
+       jj = ((gindex_proc(i)-1)/iim)+1
+       ii = (gindex_proc(i)-(jj-1)*iim)
+       
+       DO it=1,nbdays
+          mask=.FALSE.
+          DO ist=1,stpday
+             mask((it-1)*stpday+ist) = .TRUE.
+          ENDDO
+          imax = MAXLOC(swdown_subd(i,:), mask)
+          IF ( sinangles(ii,jj,imax(1)) > dusk_angle ) THEN
+             inoon(i,it) = imax(1)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE forcingdaily_solar
+!! =============================================================================================================================
+!! SUBROUTINE: forcingdaily_lwdown
+!!
+!!
+!>\BRIEF        Re-generates the LWdown variable.
+!!
+!! DESCRIPTION: For the moment LW down is maintained to the mean value over the full diurnal cycle. An idea would be to
+!!              to introduce a diurnal cycle related to the lower atmospheric temperature (Tair).
+!!  
+!! \n
+!_ ==============================================================================================================================
+!
+!! Interpolation of LWdown
+!!
+  SUBROUTINE forcingdaily_lwdown(tloc, dt, szdom, szslab, time_slab, &
+       &                         lwdown, szsubd, stpday, lwdown_subd)
+    !
+    ! Arguments
+    !
+    REAL(r_std), INTENT(in)    :: tloc, dt
+    INTEGER(i_std), INTENT(in) :: szdom, szslab, stpday, szsubd
+    REAL(r_std), INTENT(in)    :: time_slab(szslab)
+    REAL(r_std), INTENT(in)    :: lwdown(szdom,szslab)
+    REAL(r_std), INTENT(out)   :: lwdown_subd(szdom,szsubd)
+    !
+    ! Local
+    !
+    INTEGER(i_std) :: i, iday, it, ist, imin(1)
+    REAL(r_std)    :: julian
+    !
+    lwdown_subd(:,:) = undef_sechiba
+    DO i=1,szdom
+       DO iday=1,nbdays
+          DO it=1,stpday
+             ist = (iday-1)*stpday+it
+             julian = INT(time_subd(ist) + current_day)+0.5
+             imin = MINLOC(ABS((julian - time_slab(1:szslab))))
+             lwdown_subd(i,ist) = lwdown(i,imin(1))
+          ENDDO
+       ENDDO
+    ENDDO
+  END SUBROUTINE forcingdaily_lwdown
+  !! =============================================================================================================================
+!! SUBROUTINE: forcingdaily_tair
+!!
+!!
+!>\BRIEF        Re-generates the Tair variable.
+!!
+!! DESCRIPTION: 
+!!  
+!! \n
+!_ ==============================================================================================================================
+!
+!! Interpolation of Tair
+!!
+  SUBROUTINE forcingdaily_tair(tloc, dt, szdom, nbdays, szslab, time_slab, tairmin, tairmax, &
+       &                       irise, inoon, szsubd, tair_subd)
+    !
+    ! Arguments
+    !
+    REAL(r_std), INTENT(in)    :: tloc, dt
+    INTEGER(i_std), INTENT(in) :: szdom, szslab, nbdays, szsubd
+    REAL(r_std), INTENT(in)    :: time_slab(szslab)
+    REAL(r_std), INTENT(in)    :: tairmin(szdom,szslab), tairmax(szdom,szslab)
+    INTEGER(i_std), INTENT(in) :: irise(szdom,nbdays), inoon(szdom,nbdays)
+    REAL(r_std), INTENT(out)    :: tair_subd(szdom,szsubd)
+    !
+    ! Local
+    !
+    INTEGER(i_std) :: i, it, imin(1), in, ir
+    INTEGER(i_std) :: stpday, nbshift
+    REAL(r_std)    :: julian
+    !
+    stpday = NINT(REAL(szsubd/nbdays))
+    nbshift = NINT(REAL(tmaxshift/dt))
+    !
+    tair_subd(:,:) = undef_sechiba
+    DO i=1,szdom
+       DO it=1,nbdays
+          !
+          ! Tairmax position
+          !
+          in = (it-1)*stpday + MOD(inoon(i,it)+nbshift-1, stpday)+1
+          !! in = inoon(i,it)+nbshift
+          julian = INT(time_subd(in) + current_day)+0.5
+          imin = MINLOC(ABS((julian - time_slab(1:szslab))))
+          tair_subd(i,in) = tairmax(i,imin(1))
+          !
+          ! Tairmin position
+          !
+          ir = irise(i,it)
+          julian = INT(time_subd(ir) + current_day)+0.5
+          imin = MINLOC(ABS((julian - time_slab(1:szslab))))
+          tair_subd(i,ir) = tairmin(i,imin(1))
+       ENDDO
+    ENDDO
+    !
+    CALL forcingdaily_linint(szdom, szsubd, nbdays, tair_subd)
+    !
+  END SUBROUTINE forcingdaily_tair
+!!
+!! =============================================================================================================================
+!! SUBROUTINE: forcingdaily_precip
+!!
+!>\BRIEF        Distributes the rainfall of a day on a period spreadprec in a random place within the diurnal cycle.
+!!
+!! DESCRIPTION: Rainfall is distributed randomly within the day over the spreadprec period. A wide room for improvements here.
+!!              We need to think about the geographical variations of spreadprec and the most lieky time of day for rainfall.
+!!  
+!! \n
+!_ ==============================================================================================================================
+!  
+  SUBROUTINE forcingdaily_precip(tloc, dt, iim, jjm, lon, lat, gindex_proc, &
+       &                        szdom, szslab, time_slab, rainf, snowf, tair, &
+       &                        szsubd, rainf_subd, snowf_subd)
+    !
+    ! Arguments
+    !
+    REAL(r_std), INTENT(in)    :: tloc, dt
+    INTEGER(i_std), INTENT(in) :: szdom, szslab
+    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
+    INTEGER(i_std), INTENT(in) :: gindex_proc(szdom)
+    REAL(r_std), INTENT(in)    :: time_slab(szslab)
+    REAL(r_std), INTENT(in)    :: rainf(szdom,szslab), snowf(szdom,szslab)
+    REAL(r_std), INTENT(in)    :: tair(szdom,szslab)
+    INTEGER(i_std), INTENT(in) :: szsubd
+    REAL(r_std), INTENT(out)   :: rainf_subd(szdom,szsubd), snowf_subd(szdom,szsubd)
+    !
+    ! Local
+    !
+    INTEGER(i_std)   :: i, ist, iday, it, ip
+    INTEGER(i_std)   :: imin(1)
+    INTEGER(i_std)   :: stpday, nbstep
+    REAL(r_std)      :: julian, rr, rainlength
+    !
+    stpday = NINT(REAL(szsubd/nbdays))
+    !
+    rainf_subd(:,:) = zero
+    snowf_subd(:,:) = zero
+    !
+    DO i=1,szdom
+       DO iday=1,nbdays
+          !
+          ist = (iday-1)*stpday+INT(stpday/2)
+          julian = INT(time_subd(ist) + current_day)+0.5
+          imin = MINLOC(ABS((julian - time_slab(1:szslab))))
+          !
+          ! Air temperature decides how long the rainfall will be !
+          ! When it is cold the precipitation will last 3 times longer.
+          !
+          rainlength=spreadprec + MIN(MAX(convprec_temp - (tair(i,imin(1)) - tp_00), 0.0), &
+               convprec_temp)/convprec_temp*3.0*spreadprec
+          nbstep = NINT(REAL(rainlength/dt))
+          !
+          IF (rainf(i,imin(1)) > zero .OR. snowf(i,imin(1)) > zero) THEN
+             CALL random_number(rr)
+             it = INT(rr*stpday)+1
+             DO ist=1,nbstep
+                ip = MOD(it-1+(ist-1),stpday)+1
+                rainf_subd(i,(iday-1)*stpday+ip) = rainf(i,imin(1))*one_day/rainlength*dt
+                snowf_subd(i,(iday-1)*stpday+ip) = snowf(i,imin(1))*one_day/rainlength*dt
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE forcingdaily_precip
+!
+END MODULE forcingdaily_tools
Index: /branches/publications/ORCHIDEE-AFP/src_driver/getlandseamask.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/getlandseamask.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/getlandseamask.f90	(revision 8430)
@@ -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 lower case 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-AFP/src_driver/getprec.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/getprec.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/getprec.f90	(revision 8430)
@@ -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-AFP/src_driver/globgrd.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/globgrd.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/globgrd.f90	(revision 8430)
@@ -0,0 +1,903 @@
+!  ==============================================================================================================================\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) :: ip1, im1, jp1, jm1, di, dj
+    REAL(r_std) :: limlon, limlat
+    INTEGER(i_std), DIMENSION(2) :: lolaid 
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: varfull, dist
+    INTEGER(i_std), DIMENSION(2)             :: closest
+    REAL(r_std), PARAMETER :: epsilon=0.001
+    !
+    !
+    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
+             ! Get neighbours
+             ip1=ii+1
+             im1=ii-1
+             jp1=jj+1
+             jm1=jj-1
+             di=2
+             dj=2
+             ! Treat exceptions
+             IF (ip1 > iim) THEN
+                ip1=iim
+                di=1
+             ENDIF
+             IF (im1 < 1) THEN
+                im1=1
+                di=1
+             ENDIF
+             IF ( jp1 > jjm) THEN
+                jp1=jjm
+                dj=1
+             ENDIF
+             IF ( jm1 < 1) THEN
+                jm1=1
+                dj=1
+             ENDIF
+             ! Calculate limits
+             limlon=ABS(lon(ip1,jj)-lon(im1,jj))/di-epsilon
+             limlat=ABS(lat(ii,jp1)-lat(ii,jm1))/dj-epsilon
+             !
+             IF ( ABS(lalo(i,1)-lat(ii,jj)) < limlat .AND. ABS(lalo(i,2)-lon(ii,jj)) < limlon ) 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-AFP/src_driver/orchideedriver.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/orchideedriver.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/orchideedriver.f90	(revision 8430)
@@ -0,0 +1,945 @@
+! =================================================================================================================================
+! 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 time
+  USE timer
+  USE constantes
+  USE constantes_soil
+  USE forcing_tools
+  USE globgrd
+  !
+  USE sechiba
+  USE control
+  USE ioipslctrl
+  USE xios_orchidee
+  !
+  !-
+  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, in, nbdt, first_point
+  INTEGER(i_std) :: itau, itau_offset, itau_sechiba
+  REAL(r_std)    :: date0, date0_shifted, dt, julian
+  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 (:)             :: 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), ALLOCATABLE, DIMENSION (:,:)          :: veget_diag    !! Fraction of vegetation type (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)          :: lai_diag      !! Leaf area index (m^2 m^{-2}
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)          :: height_diag   !! Vegetation Height (m)
+  !-
+  !-
+  !-
+  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
+
+  OFF_LINE_MODE = .TRUE. 
+
+  !-
+  !---------------------------------------------------------------------------------------
+  !- 
+  !- 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, regular_lonlat, "ForcingGrid")
+  ELSE IF ( model_guess == "WRF") THEN
+     CALL grid_init (nbp_loc, nbseg, regular_xy, "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(corners_lon(nbseg,iim,jjm), corners_lat(nbseg,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))
+  DO in=1,nbseg
+     corners_lon(in,:,:)=corners_glo(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank),in,1)
+     corners_lat(in,:,:)=corners_glo(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank),in,2)
+  ENDDO
+  !
+  !
+  ! 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)
+  !
+  !-
+  !- Set the start date in IOIPSL for the calendar and initialize the module time
+  !-
+  CALL ioconf_startdate(date0)
+  CALL time_initialize(0, date0, dt, "END")
+  !
+  !
+  !====================================================================================
+  !-
+  !- 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)
+  !
+  !-
+  !====================================================================================
+  !-
+  !- Initialise the ORCHIDEE system in 4 steps :
+  !- 1 The control flags,
+  !- 2 Allocate memory (needs to be done after initializing the control flags because of nvm). 
+  !- 2 the restart system of IOIPSL
+  !- 3 The history mechanism
+  !- 4 Finally the first call to SECHIBA will initialise all the internal variables
+  !
+  ! 1 Setting flags and some parameters (nvm)
+  !
+  CALL control_initialize
+  !
+  ! 2 Allocation
+  !
+  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))
+  ALLOCATE(veget_diag(kjpindex,nvm))
+  ALLOCATE(lai_diag(kjpindex,nvm))
+  ALLOCATE(height_diag(kjpindex,nvm))
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- 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
+  !
+  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
+  !
+  WRITE(*,*) "itau_offset : date0 : ", year_end, month_end, day_end, sec_end
+  !
+  CALL xios_orchidee_init( MPI_COMM_ORCH,                &
+       date0,    year_end, month_end, day_end, julian_diff,  &
+       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(*,*) "HISTORY : Defined for ", itau_sechiba, date0, dt
+  !
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  !- Go into the time loop
+  !-
+  !---------------------------------------------------------------------------------------
+  !-
+  DO itau = 1,nbdt
+     !
+     CALL time_nextstep( itau )
+     !     
+     timestep_interval(1) = julian_start
+     timestep_interval(2) = julian_end
+     julian = julian_end
+     !
+     ! 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)
+     !-
+     !
+     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)
+     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,                  &
+             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)
+        !
+        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, 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, &
+          ! Vegetation, lai and vegetation height
+          & veget_diag, lai_diag, height_diag, &
+          ! 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("temp_air",temp_air)
+     CALL xios_orchidee_send_field("qair",qair)
+     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("pb",pb)
+     !
+     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 xios_orchidee_context_finalize
+  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
+    !-
+    !- 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(corners_lon) ) DEALLOCATE(corners_lon)
+    IF ( ALLOCATED(corners_lat) ) DEALLOCATE(corners_lat)
+    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)
+    IF ( ALLOCATED(z0h) ) DEALLOCATE(z0h)
+    !
+    WRITE(numout,*) "Memory deallocated"
+    !
+  END SUBROUTINE orchideedriver_clear
+  !
+END PROGRAM orchidedriver
Index: /branches/publications/ORCHIDEE-AFP/src_driver/readdim2.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/readdim2.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/readdim2.f90	(revision 8430)
@@ -0,0 +1,2610 @@
+!  ==============================================================================================================================\n
+!  MODULE 	: readdim2
+! 
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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 time
+   USE solar
+   USE grid
+   USE mod_orchidee_para
+
+   IMPLICIT NONE
+
+   PRIVATE
+   PUBLIC  :: forcing_read, forcing_info, forcing_grid
+
+   INTEGER, SAVE                            :: iim_full, jjm_full, llm_full, ttm_full
+   INTEGER, SAVE                            :: iim_zoom, jjm_zoom
+   INTEGER, SAVE                            :: iim_g_begin,jjm_g_begin,iim_g_end,jjm_g_end
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:)  :: data_full, lon_full, lat_full
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:)    :: lev_full
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: itau, i_index, j_index,j_index_g
+   INTEGER, SAVE                            :: i_test, j_test
+   INTEGER, SAVE                            :: printlev_loc   !! Local printlev
+   LOGICAL, SAVE                            :: allow_weathergen, interpol, daily_interpol
+   LOGICAL, SAVE, PUBLIC                    :: weathergen, is_watchout
+   REAL, SAVE                               :: merid_res, zonal_res
+   LOGICAL, SAVE                            :: have_zaxis=.FALSE.
+!-
+!- Heigh controls and data 
+!- 
+   LOGICAL, SAVE                            :: zfixed, zsigma, zhybrid, zlevels, zheight 
+   LOGICAL, SAVE                            :: zsamelev_uv 
+   REAL, SAVE                               :: zlev_fixed, zlevuv_fixed 
+   REAL, SAVE                               :: zhybrid_a, zhybrid_b 
+   REAL, SAVE                               :: zhybriduv_a, zhybriduv_b 
+
+CONTAINS
+
+!! ==============================================================================================================================\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
+    IF ( printlev_loc>=3 ) 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))
+    !-
+    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
+       IF (printlev_loc >= 1) 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
+          IF ( printlev_loc>=1 ) 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
+    IF (printlev_loc >= 1) 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.
+          IF (printlev_loc >= 1) 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.
+       IF (printlev_loc >= 1) 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)
+
+          ALLOCATE(fcontfrac(iim_zoom,jjm_zoom))
+          CALL flinquery_var(force_id, 'contfrac', contfrac_exists)
+          IF ( contfrac_exists ) THEN
+             IF (printlev_loc >= 1) 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)
+             IF (printlev_loc >= 2) 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
+
+          DEALLOCATE(fcontfrac)
+
+          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,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')
+       IF (printlev_loc >= 2) WRITE(numout,*) 'Standard PRINTLEV= ', printlev
+       IF (printlev_loc >= 2) WRITE(numout,*) '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, lwdown_cons, swdown_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) :: lwdown_cons         !! Flag to conserve lwdown radiation from forcing
+   LOGICAL, INTENT(IN) :: swdown_cons         !! Flag to conserve swdown radiation from forcing
+   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, lwdown_cons, swdown_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
+         IF (printlev_loc >= 2) 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, regular_lonlat, "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, lwdown_cons, swdown_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
+!- lwdown_cons: flag that decides if lwdown radiation should be conserved.
+!- swdown_cons: flag that decides if swdown 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, INTENT(IN) :: lwdown_cons, swdown_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
+!  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.
+!  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 (printlev_loc >= 5) 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 (printlev_loc >= 5) 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 (printlev_loc >= 5) 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)
+!----
+
+!-- First in case it's not a watchout file
+     IF ( .NOT. is_watchout ) THEN
+        IF ( contfrac_exists ) THEN
+           IF (printlev_loc >= 1) 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)
+           IF (printlev_loc >= 2) 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, 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 (printlev_loc >= 5) THEN
+           WRITE(numout,*) 'New test point is : ', i_test, j_test
+        ENDIF
+        !---
+        !--- Allocate grid stuff
+        !---
+        CALL grid_init ( nbindex, 4, regular_lonlat, "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, 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 (printlev_loc >= 5) THEN
+           WRITE(numout,*) 'New test point is : ', i_test, j_test
+        ENDIF
+        !---
+        !--- Allocate grid stuff
+        !---
+        CALL grid_init ( nbindex, 4, regular_lonlat, "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
+           IF (printlev_loc >= 2) 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
+     IF (printlev_loc >= 2) WRITE(numout,*) 'contfrac : ', MINVAL(fcontfrac), MAXVAL(fcontfrac)
+!---
+   ENDIF
+!---
+   IF (printlev_loc >= 5) THEN
+      WRITE(numout,*) &
+           & 'The dates : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+   ENDIF
+!---
+!--- Here we do the work in case only interpolation is needed.
+!---
+   IF ( initialized .AND. interpol ) THEN
+!---
+      IF ( daily_interpol ) THEN
+
+         IF (split > 1) THEN
+            IF ( itau_split <= (split/2.) ) THEN
+               rw = REAL(itau_split+split/2.)/split
+            ELSE 
+               rw = REAL(itau_split-split/2.)/split
+            ENDIF
+         ELSE
+            rw = 1.
+         ENDIF
+
+         IF ((last_read == 0) .OR. ( rw==(1./split)) ) THEN
+   !---
+   !-----   Start or Restart
+            IF (last_read == 0) THEN
+               ! Case of a restart or a shift in the forcing file.
+               IF (itau_read > 1) THEN
+                  itau_read_nm1=itau_read-1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tmin_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists)
+                  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
+                  IF (printlev_loc >= 2) 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)
+                  CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_nm1, itau_read_nm1, tmax_nm1, force_id )
+               ENDIF
+               tmin_nm2(:,:)=tmin_nm1(:,:)
+               IF ( dt_force .GT. 3600. ) THEN
+                  mean_coszang(:,:) = 0.0
+                  daylength_n(:,:) = 0.
+                  DO is=1,split
+                     !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                     julian = julian_for+((is-0.5)/split)*dt_force/one_day
+                     ! first day of this year
+                     CALL ymds2ju (yy,1,1,0.0, julian0)
+      !!$               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 (printlev_loc >= 5) THEN
+               WRITE(numout,*) &
+                    & 'The dates 2 : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+            ENDIF
+   !-----
+   !----- Get a reduced julian day !
+   !----- This is needed because we lack the precision on 32 bit machines.
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               julian_for = itau2date(itau_read-1, date0, dt_force)
+               CALL ju2ymds (julian_for, yy, mm, dd, ss)
+   
+               ! first day of this year
+               CALL ymds2ju (yy,1,1,0.0, julian0)
+   !-----
+               IF (printlev_loc >= 5) 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)
+            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 (printlev_loc >= 5) WRITE(numout,*) 'Going into  solarang', split, one_day
+   !-----
+
+   !-----
+         ENDIF
+   !---
+         IF ( itau_split == 1. ) THEN
+            IF ( dt_force .GT. 3600. ) THEN
+               mean_coszang(:,:) = 0.0
+               daylength_nm1(:,:)=daylength_n(:,:)
+               daylength_n(:,:) = 0.
+               DO is=1,split
+                  !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                  julian = julian_for+((is-0.5)/split)*dt_force/one_day
+   !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                  ! first day of this year
+                  CALL ymds2ju (yy,1,1,0.0, julian0)
+                  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 (printlev_loc >= 5) WRITE(numout,*) 'Doing the interpolation between time steps'
+   !---
+
+         IF (printlev_loc >= 5) 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 ( lwdown_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, conservative approach under 2000W/m2
+   !----
+         IF (printlev_loc >= 5) WRITE(numout,*) 'Ready to deal with the solar radiation'
+   !----
+         ! We compute mean SWdown between t and t+Dt then we 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 (printlev_loc >= 5) 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
+         
+         IF (printlev_loc >= 5) 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 (printlev_loc >= 5) 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 not daily_interpol
+         
+         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)
+               ! 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)
+                  IF (printlev_loc >= 1) WRITE(numout,*) "The forcing file contains 24 hours :",dt_force*ttm,one_day-1.
+                  IF (printlev_loc >= 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)
+               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 (printlev_loc >= 5) THEN
+               WRITE(numout,*) &
+                    & 'The dates 2 : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+            ENDIF
+   !-----
+   !----- Get a reduced julian day !
+   !----- This is needed because we lack the precision on 32 bit machines.
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               julian_for = itau2date(itau_read-1, date0, dt_force)
+               CALL ju2ymds (julian_for, yy, mm, dd, ss)
+   
+               ! first day of this year
+               CALL ymds2ju (yy,1,1,0.0, julian0)
+   !-----
+               IF (printlev_loc >= 5) 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)
+   !---
+            last_read = itau_read_n
+   !-----
+   !----- Compute mean solar angle for the comming period
+   !-----
+            IF (printlev_loc >= 5) WRITE(numout,*) 'Going into  solarang', split, one_day
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               mean_coszang(:,:) = 0.0
+               DO is=1,split
+                  !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                  julian = julian_for+((is-0.5)/split)*dt_force/one_day
+                  ! first day of this year
+                  CALL ymds2ju (yy,1,1,0.0, julian0)
+   !!$               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 (printlev_loc >= 5) WRITE(numout,*) 'Doing the interpolation between time steps'
+   !---
+         IF (split > 1) THEN
+            rw = REAL(itau_split)/split
+         ELSE
+            rw = 1.
+         ENDIF
+         IF (printlev_loc >= 5) 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 ( lwdown_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 (printlev_loc >= 5) WRITE(numout,*) 'Ready to deal with the solar radiation'
+   !----
+         IF ( dt_force .GT. 3600. ) THEN
+
+            ! In this case solar radiation will be conserved
+  
+            ! We compute mean SWdown between t and t+Dt then we 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 (printlev_loc >= 5) 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 dt_force < 3600 (1h)
+
+            IF ( swdown_cons ) THEN
+               ! Conserve swdown radiation
+               swdown(:,:) = swdown_n(:,:)
+            ELSE
+               swdown(:,:) = (swdown_n(:,:)-swdown_nm1(:,:))*rw + swdown_nm1(:,:)
+            ENDIF
+   !---
+         ENDIF
+   !---
+         IF (printlev_loc >= 5) 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 (printlev_loc >= 5) 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)
+!---------------------------------------------------------------------
+!- 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)
+!---------------------------------------------------------------------
+   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
+   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 (printlev_loc >= 5) 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, 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)
+!-
+!- 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 (printlev_loc >= 5) 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 (printlev_loc >= 5) 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
+        IF (printlev_loc >= 1) 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
+        IF (printlev_loc >= 1) WRITE(numout,*) "forcing_vertical_ioipsl : case Pressure coordinates : "
+        IF (printlev_loc >= 1) 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
+
+  IF (printlev_loc >= 1) 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
+    INTEGER         :: nbuff_new                             !! Temporary variable for nbuff used in the end of the forcing file
+    
+    !! 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
+       IF (printlev_loc >= 1) WRITE(numout,*)'flinget_buffer: NBUFF=',nbuff,' number of time step will be buffered'
+       IF (printlev_loc >= 1) 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
+       
+       ! Check and correct if data_buffer(index)%iend is exceeding file size
+       IF (data_buffer(index)%iend > ttm) THEN
+          ! iend is exceeding the limit of the file. Change iend to the last time step in the file. 
+          data_buffer(index)%iend = ttm
+
+          ! Calculate a new smaller nbuff
+          nbuff_new = ttm - itb + 1
+
+          ! Resize data buffer
+          DEALLOCATE(data_buffer(index)%data)
+          ALLOCATE(data_buffer(index)%data(iim_full,jjm_full, nbuff_new), stat=ierr )
+          IF (ierr /= 0) CALL ipslerr_p(3,'flinget_buffer','pb realloc data_buffer%data with new nbuff','','')
+       END IF
+
+!       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-AFP/src_driver/testrouting.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/testrouting.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/testrouting.f90	(revision 8430)
@@ -0,0 +1,442 @@
+! =================================================================================================================================
+! 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 time
+  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, regular_lonlat, "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
+  ! 
+  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,nslm), 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-AFP/src_driver/teststomate.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/teststomate.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/teststomate.f90	(revision 8430)
@@ -0,0 +1,1182 @@
+! =================================================================================================================================
+! PROGRAM       : teststomate
+!
+! CONTACT	: orchidee-help _at_ listes.ipsl.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 time, ONLY : time_initialize, time_nextstep
+  USE slowproc
+  USE stomate
+  USE intersurf, ONLY: 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
+
+!! liulyc liulyw link from xuhui's crop
+  REAL(r_std),DIMENSION (:), ALLOCATABLE    :: swdown                               !!downward shortwave radiation
+
+
+  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 (impose_veg, land_use, lcchange...previously in slowproc)
+
+  CALL veget_config
+
+  ! 6. Read the parameters in the run.def file
+
+  IF (impose_param) THEN
+     CALL config_pft_parameters
+     CALL config_stomate_pft_parameters
+     CALL config_co2_parameters
+     CALL config_stomate_parameters
+  ENDIF
+  !-
+  IF (ok_dgvm) THEN
+     IF ( impose_param ) THEN
+        CALL config_dgvm_parameters
+     ENDIF
+  ENDIF
+!-
+  !-
+  ! restart files
+  !-
+  IF (is_root_prc) THEN
+     ! Sechiba's restart files
+     sec_restname_in = 'sechiba_start.nc'
+     CALL getin('SECHIBA_restart_in',sec_restname_in)
+     WRITE(numout,*) 'SECHIBA INPUT RESTART_FILE: ',TRIM(sec_restname_in)
+     IF ( TRIM(sec_restname_in) .EQ. 'NONE' ) THEN
+        STOP 'Need a restart file for Sechiba'
+     ENDIF
+     sec_restname_out = 'sechiba_rest_out.nc'
+     CALL getin('SECHIBA_rest_out',sec_restname_out)
+     WRITE(numout,*) 'SECHIBA OUTPUT RESTART_FILE: ',TRIM(sec_restname_out)
+     ! Stomate's restart files
+     sto_restname_in = 'stomate_start.nc'
+     CALL getin('STOMATE_RESTART_FILEIN',sto_restname_in)
+     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in)
+     sto_restname_out = 'stomate_rest_out.nc'
+     CALL getin('STOMATE_RESTART_FILEOUT',sto_restname_out)
+     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out)
+
+     !-
+     ! We need to know iim, jjm.
+     ! Get them from the restart files themselves.
+     !-
+     iret = NF90_OPEN (sec_restname_in,NF90_NOWRITE,ncfid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'Could not open file : ', &
+             &          sec_restname_in,'(Do you have forget it ?)')
+     ENDIF
+     iret = NF90_INQUIRE_DIMENSION (ncfid,1,len=iim_g)
+     iret = NF90_INQUIRE_DIMENSION (ncfid,2,len=jjm_g)
+     iret = NF90_INQ_VARID (ncfid, "time", iv)
+     iret = NF90_GET_ATT (ncfid, iv, 'calendar',thecalendar)
+     iret = NF90_CLOSE (ncfid)
+     i=INDEX(thecalendar,ACHAR(0))
+     IF ( i > 0 ) THEN
+        thecalendar(i:20)=' '
+     ENDIF
+  ENDIF
+  CALL bcast(iim_g)
+  CALL bcast(jjm_g)
+  CALL bcast(thecalendar)
+  !-
+  ! calendar
+  !-
+  CALL ioconf_calendar (thecalendar)
+  CALL ioget_calendar  (one_year,one_day)
+  !
+  ! Parallelization :
+  !
+!  CALL init_data_para(iim_g,jjm_g,nbp_glo,indices_g)
+  CALL 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, regular_lonlat, "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,nslm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soilhum(kjpindex,nslm),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
+
+  !! liulyc liulyw linked from xuhui's code
+  ALLOCATE(swdown(kjpindex),stat=ier)
+  IF (ier.NE.0) CALL ipslerr_p (3,'teststomate', 'swdown cannot be allocated','There is not enough memory', '')
+  swdown(:) = 0
+  !! liulyc liulyw
+
+  !
+  ! 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(swdown)*KIND(swdown) + & !! liulyc liulyw linked from xuhui's crop
+       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 time_initialize(itau_dep, date0, dt_sechiba, "START")
+  !-
+  ! 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, nslm-1
+     ! first 2.0 is dpu 
+     ! second 2.0 is average
+     diaglev(l) = zmaxh/(2**(nslm-1) -1) * ( ( 2**(l-1) -1) + ( 2**(l) -1) ) / 2.0
+  ENDDO
+  diaglev(nslm) = 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
+
+
+  days_since_beg=1
+
+  CALL time_nextstep( itau_dep+itau_step )
+  
+  lstep_init_intersurf=.FALSE.
+  !-
+  ! 4. Time loop
+  !â»
+  DO itau = itau_dep+itau_step,itau_fin,itau_step
+    !
+    !
+    CALL time_nextstep( itau )
+    !-
+    ! 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)
+     swdown(:) = swdown_fm(:,iisf) !! liulyc liulyw xuhui's crop link from xchen
+     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, &
+ &     swdown)!!liulyc liulyw xuhui's crop but xchen used it.)
+
+  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-AFP/src_driver/weather.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_driver/weather.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_driver/weather.f90	(revision 8430)
@@ -0,0 +1,4005 @@
+! =================================================================================================================================
+! MODULE       : weather
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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 time, ONLY : year, month, day, sec, one_day
+  USE time, ONLY : one_day
+!-
+  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,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-AFP/src_global/AA_make
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/AA_make	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/AA_make	(revision 8430)
@@ -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-AFP/src_global/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/AA_make.ldef	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/AA_make.ldef	(revision 8430)
@@ -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-AFP/src_global/gauss_jordan_method.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/gauss_jordan_method.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/gauss_jordan_method.f90	(revision 8430)
@@ -0,0 +1,244 @@
+! =================================================================================================================================
+! MODULE       : matrix_resolution
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         This module solves a linear system using the Gauss-Jordan elimination method. It also calculates relative errors
+!! globally and for the passive pools.        
+!! 
+!!
+!!\n DESCRIPTION:  This module solves a linear system AX = B with the Gauss Jordan elimination method
+!!                 (chosen because the system has no particular properties). \n
+!!                 The code has originally picked up in Numerical recipes in Fortran 90. \n
+!!                 We simplified the code in our case because we solve a basic (7,7) matrix for each point and each pft
+!!                 (so we have npts*nvm*(7,7) systems to solve each time we call this routine). \n
+!!                 We also calculate relative for biomass and passive carbon pools in order to test the threshold error. \n
+!!
+!! RECENT CHANGE(S): Didier Solyga - add subroutine for calculating relative error for passive pool.
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision:  $
+!! \n
+!_ ================================================================================================================================
+
+MODULE matrix_resolution
+
+  ! modules used 
+
+  USE ioipsl ! for precision
+  USE constantes
+
+  IMPLICIT NONE
+
+  CONTAINS
+    
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gauss-jordan_method 
+!!
+!>\BRIEF          This subroutine resolves a linear system by the Gauss-Jordan method.
+!! (inversion of the system - complexity O(n^3)) .
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vector_b contains the solution of the system.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE gauss_jordan_method(n,matrix_a,vector_b)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration    
+
+      !! 0.1 Input variables 
+ 
+      INTEGER(i_std), INTENT(in) :: n  !! size of the system (1-N, unitless)
+
+      !! 0.3 Modified variables
+
+      REAL(r_std), DIMENSION(n,n), INTENT(inout) :: matrix_a   !! Matrix A of the linear system A.X = B
+      REAL(r_std), DIMENSION(n), INTENT(inout)   :: vector_b   !! Vector B in the linear system A.X = B
+      
+      !! 0.4 Local Variables
+
+      INTEGER(i_std) :: i,col,row,j,k,ii,jj        !! index (unitless)
+      INTEGER(i_std), DIMENSION(n) :: index_pivot  !! vector containing the pivot index
+      INTEGER(i_std), DIMENSION(n) :: index_col    !! vector containing the columns index
+      INTEGER(i_std), DIMENSION(n) :: index_row    !! vector containing the rows index
+      REAL(r_std) :: pivot_max,inv_pivot,temp      !! temporary variables
+      
+!_ ================================================================================================================================
+      
+      !! Initialization
+      index_pivot(:) = 0
+      col = 0
+      row = 0
+      
+      !! Search the pivot (strategy of full pivoting)
+      !! We search the greatest pivot (in order to reduce errors)
+      DO i = 1,n     
+         pivot_max = 0.
+         DO  j = 1,n
+            IF(index_pivot(j) /= 1) THEN
+               DO k = 1,n
+                  IF(index_pivot(k) .EQ. 0) THEN
+                     IF(ABS(matrix_a(j,k)) .GE. pivot_max) THEN  
+                        pivot_max = ABS(matrix_a(j,k))           
+                        row = j
+                        col = k
+                     ENDIF
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+
+         IF (col .EQ. 0) THEN
+            CALL ipslerr_p (3,'gauss_jordan_method','Method failed.','','')
+         ENDIF
+
+         index_pivot(col)=index_pivot(col) + 1
+
+         !! We exchange the rows and the lines if needed
+         IF(row /= col) THEN
+            DO j = 1,n
+               temp = matrix_a(row,j)
+               matrix_a(row,j) = matrix_a(col,j)
+               matrix_a(col,j) = temp
+            ENDDO
+            temp = vector_b(row)
+            vector_b(row) = vector_b(col)
+            vector_b(col) = temp
+         ENDIF
+         index_row(i) = row
+         index_col(i) = col
+         IF(matrix_a(col,col) .EQ. 0.) STOP 'the matrix A is not inversible'
+         inv_pivot = 1./matrix_a(col,col)
+         DO j = 1,n
+            matrix_a(col,j) = matrix_a(col,j) * inv_pivot 
+         ENDDO
+         vector_b(col) = vector_b(col) * inv_pivot
+         DO ii = 1,n
+            IF(ii /= col) THEN
+               temp = matrix_a(ii,col)
+               matrix_a(ii,col) = 0.
+               DO jj = 1,n
+                  matrix_a(ii,jj) = matrix_a(ii,jj) - matrix_a(col,jj)*temp
+               ENDDO
+               vector_b(ii) = vector_b(ii) - vector_b(col)*temp
+            ENDIF
+         ENDDO
+      ENDDO
+      
+      DO j = n,1,-1
+         IF(index_row(j) /= index_col(j)) THEN
+            DO i = 1,n
+               temp = matrix_a(i,index_row(j))
+               matrix_a(i,index_row(j)) = matrix_a(i,index_col(j)) 
+               matrix_a(i,index_col(j)) = temp
+          ENDDO
+       ENDIF
+    ENDDO
+    
+    
+  END SUBROUTINE gauss_jordan_method
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : error_L1_passive
+!!
+!>\BRIEF          This subroutine calculates relative errors of a vector by taking the relative error for the passive pool.
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): flag is to true if the maximum relative error is less than a threshold chosen by the user.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE error_L1_passive(npts,nb_veget, nb_pools, current_value, previous_value, veget_max, criterion, flag)
+  
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables    
+    
+    INTEGER(i_std), INTENT(in) :: npts                                             !! Number of continental grid cells (unitless)
+    INTEGER(i_std), INTENT(in) :: nb_veget                                         !! Number of vegetation types (2-N, unitless)
+    INTEGER(i_std), INTENT(in) :: nb_pools                                         !! Number of carbon pools (unitless)
+    REAL(r_std), DIMENSION(npts,nb_veget,nb_pools), INTENT(in) :: current_value    !! Previous values of carbon pools obtained
+                                                                                   !! by matrix resolution (gC.m^{-2})
+    REAL(r_std), DIMENSION(npts,nb_veget,nb_pools), INTENT(in) :: previous_value   !! Current values of carbon pools  obtained
+                                                                                   !! by matrix resolution (gC.m^{-2})   
+    REAL(r_std), DIMENSION(npts,nb_veget), INTENT(in) :: veget_max                 !! Fraction of vegetation (0-1, uniless)
+    REAL(r_std), INTENT(in) :: criterion                                           !! Threshold for the relativ error (0-1, unitless) 
+    
+    !! 0.2 Output variables
+    
+    LOGICAL, DIMENSION(npts), INTENT(out) :: flag   !! Logical array used only inside this subroutine (true/false)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std) :: j                                      !! Index (unitless)
+    REAL(r_std), DIMENSION(npts) :: previous_passive_stock   !! Previous value of total passive carbon (gC) 
+    REAL(r_std), DIMENSION(npts) :: current_passive_stock    !! Current value of total passive carbon (gC)
+    REAL(r_std), DIMENSION(npts) :: error_global             !! Temporary arrays containing the relative error for each grid cell 
+                                                             !! (unitless)         
+    REAL(r_std), DIMENSION(npts) :: temp_diff                !! Working array storing difference values between previous_passive_stock
+                                                             !! and current_passive_stock (gC)
+
+!_ ================================================================================================================================
+
+    !! Initialize flag and error_global
+    flag(:) = .FALSE.
+    error_global(:) = zero
+
+    !! Calculation previous_passive_stock
+    previous_passive_stock(:) = zero
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool)*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-AFP/src_global/grid.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/grid.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/grid.f90	(revision 8430)
@@ -0,0 +1,1099 @@
+
+!! 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 is used 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.
+!!
+MODULE grid
+
+  USE grid_var
+  USE defprec
+  USE mod_orchidee_para_var
+  USE mod_orchidee_transfert_para
+  USE haversine
+  USE module_llxy
+
+  USE ioipsl
+  USE netcdf
+
+  IMPLICIT NONE
+
+  PUBLIC grid_init, grid_init_unstructured, grid_set_glo, grid_allocate_glo, grid_stuff, grid_tolola, grid_initproj
+
+  !
+  !=================================================================================
+  !
+  ! 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
+  REAL(r_std), PARAMETER :: default_resolution = 250000.  !! default resolution (m)
+  
+  ! VARIABLES
+  !
+  !-
+  !- Variable to help describe the grid
+  !- once the points are gathered.
+  !-
+  REAL(r_std), SAVE                                   :: limit_west, limit_east     !! Limits of the domain
+  REAL(r_std), SAVE                                   :: limit_north, limit_south   !! Limits of the domain
+!$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)
+  !
+  !
+  !
+  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
+  !
+  !
+  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
+
+!!  =============================================================================================================================
+!! 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_gathered, readdim2, orchideedriver 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
+    INTEGER(i_std), INTENT(in)                                 :: gtype    !! Type of grid: regular_lonlat/regular_xy/unstructured
+    CHARACTER(LEN=*), INTENT(in)                               :: gname    !! Name of the grid
+    LOGICAL, OPTIONAL                                          :: isglobal
+    !
+    ! Verify the information passed and save it in the global variables of the model.
+    !
+    IF ( gtype == regular_lonlat ) THEN
+       grid_type=regular_lonlat
+
+      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
+       IF ( PRESENT(isglobal) ) THEN
+          global = isglobal
+       ELSE
+          global = .TRUE.
+       ENDIF
+
+    ELSE IF ( gtype == regular_xy ) THEN
+       grid_type=regular_xy
+       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
+       IF ( PRESENT(isglobal) ) THEN
+          global = isglobal
+       ELSE
+          global = .FALSE.
+       ENDIF
+    ELSE IF ( gtype == unstructured ) THEN
+       grid_type=unstructured
+       NbSegments=nbseg
+       IF ( PRESENT(isglobal) ) THEN
+          global = isglobal
+       ELSE
+          global = .TRUE.
+       ENDIF
+    ELSE
+       WRITE(numout,*) "Unrecognized grid type: gtype=",gtype
+       CALL ipslerr(3, "grid_init", "unrecognized grid type.",&
+            &       "It has to be either regular_lonlat, regular_xy or unstructured","")
+    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
+  
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    grid_init_unstructured
+!!
+!>\BRIEF	  Initialization of grid description for unstructured grid.
+!!
+!! DESCRIPTION:	  
+!!                This subroutine is called by intersurf_main_gathered instead of grid_init. grid_init is called in here. 
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE grid_init_unstructured ( npts,          ncells_in,      longitude_in, latitude_in, &
+                                      bounds_lon_in, bounds_lat_in,  area_in,      ind_cell_glo_in)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std), INTENT(IN) :: npts
+    INTEGER(i_std), INTENT(IN) :: ncells_in
+    REAL(r_std), INTENT(IN)    :: longitude_in(:)
+    REAL(r_std), INTENT(IN)    :: latitude_in(:)  
+    REAL(r_std), INTENT(IN)    :: bounds_lon_in(:,:)   
+    REAL(r_std), INTENT(IN)    :: bounds_lat_in(:,:)
+    REAL(r_std), INTENT(IN)    :: area_in(:)
+    INTEGER(i_std), INTENT(IN) :: ind_cell_glo_in(:)
+    
+
+    CALL grid_init(npts, 6, unstructured, "2DGrid")
+    
+    grid_type=unstructured
+    ncells=ncells_in
+    nvertex=6     ! for now for dynamico
+    ALLOCATE(longitude(ncells))
+    ALLOCATE(latitude(ncells))
+    ALLOCATE(bounds_lon(ncells,nvertex))
+    ALLOCATE(bounds_lat(ncells,nvertex))
+    ALLOCATE(ind_cell_glo(ncells))
+    
+    longitude(:)     = longitude_in(:)
+    latitude(:)      = latitude_in(:)
+    bounds_lon(:,:)  = bounds_lon_in(:,:)
+    bounds_lat(:,:)  = bounds_lat_in(:,:)
+    area(:)          = area_in(:)
+    ind_cell_glo(:)  = ind_cell_glo_in(:)
+    
+  END SUBROUTINE grid_init_unstructured
+  
+
+!!  =============================================================================================================================
+!! 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))
+    !
+  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(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(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  !
+    ! 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(inout)                                :: 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 ( grid_type == regular_lonlat ) 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 + min_sechiba)) <= 0 .AND. (maxlon + (maxdellon + min_sechiba)) >= 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 + min_sechiba)) <= -180 .AND. (maxlon + (maxdellon + min_sechiba)) >= 180) THEN
+             globalg = .TRUE.
+          ELSE
+             globalg = .FALSE.
+          ENDIF
+       !
+       ! If neither condition is met then it cannot be global.
+       !
+       ELSE
+          globalg = .FALSE.
+       ENDIF
+    ELSE IF ( grid_type == regular_xy ) THEN
+       !
+       ! The hypothesis is that if we are using grid regular_xy then it is not a global grid
+       !
+       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, globalg, &
+     &                              nbseg, lonpoly, latpoly, center, &
+     &                              neighbours_loc, ilindex_loc, jlindex_loc)
+    ELSE IF ( grid_type == regular_lonlat ) THEN
+       CALL haversine_reglatlontoploy(iim, jjm, grid_lon, grid_lat, nland, kindex, globalg, &
+     &                              nbseg, lonpoly, latpoly, center, &
+     &                              neighbours_loc, ilindex_loc, jlindex_loc)
+    ELSE IF ( grid_type == regular_xy ) 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 ( grid_type == regular_lonlat ) THEN
+       CALL haversine_laloseglen(nland, nbseg, lonpoly, latpoly, seglength_loc)
+       CALL haversine_laloarea(nland, nbseg, seglength_loc, area_loc)
+    ELSE IF ( grid_type == regular_xy ) 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
+
+  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 ( grid_type == regular_lonlat .OR. grid_type == regular_xy ) 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.",&
+               &       "grid_scatter can only be called for regular grids.",&
+               &       "")
+       ENDIF
+    ENDIF
+    CALL scatter(resolution_g, resolution)
+
+    ! Copy variable global from root processor to all prossesors
+    CALL bcast(global)
+
+    !
+    !
+    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)
+       WRITE(numout,*) 'grid_scatter  > global  = ', global
+    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-AFP/src_global/grid_var.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/grid_var.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/grid_var.f90	(revision 8430)
@@ -0,0 +1,59 @@
+! ===============================================================================================================================
+! MODULE       : grid_var
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE grid_var
+
+  USE defprec
+  IMPLICIT NONE
+
+  !=================================================================================
+  ! Horizontal grid information
+  !=================================================================================
+  INTEGER,PARAMETER                                  :: unstructured=0   !! Index for unstructured grid
+  INTEGER,PARAMETER                                  :: regular_lonlat=1 !! Index for regular longitude-latitude grid
+  INTEGER,PARAMETER                                  :: regular_xy=2     !! Index for regular grid projected on X-Y
+  INTEGER,SAVE                                       :: grid_type        !! grid type : unstructured, regular_lonlat or regular_xy 
+!$OMP THREADPRIVATE(grid_type)
+  INTEGER(i_std), SAVE                               :: ncells           !! numbers of cells (including masked cells)
+!$OMP THREADPRIVATE(ncells)
+  INTEGER(i_std), SAVE                               :: nvertex          !! numbers of vertex by cells
+!$OMP THREADPRIVATE(nvertex)
+  INTEGER, SAVE                                      :: NbSegments       !! Number of segments in the polygone defining the grid box, same as nvertex
+!$OMP THREADPRIVATE(NbSegments)
+  INTEGER, SAVE                                      :: NbNeighb         !! Number of neighbours for each grid box
+!$OMP THREADPRIVATE(NbNeighb)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE       :: longitude        !! longitude for all cells (including masked cells)
+!$OMP THREADPRIVATE(longitude)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE       :: latitude         !! latitude for all cells (including masked cells)
+!$OMP THREADPRIVATE(latitude)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE     :: bounds_lon       !! longitude boundairies for all cells (including masked cells)
+!$OMP THREADPRIVATE(bounds_lon)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE     :: bounds_lat       !! latitude boundairies for all cells (including masked cells)
+!$OMP THREADPRIVATE(bounds_lat)
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:), SAVE    :: ind_cell_glo     !! Cells order give by indice form global grid reference
+!$OMP THREADPRIVATE(ind_cell_glo)
+
+
+END MODULE grid_var
Index: /branches/publications/ORCHIDEE-AFP/src_global/haversine.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/haversine.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/haversine.f90	(revision 8430)
@@ -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-AFP/src_global/interpol_help.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/interpol_help.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/interpol_help.f90	(revision 8430)
@@ -0,0 +1,842 @@
+!
+! 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
+
+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 (printlev >= 3) 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 (printlev >= 3) 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
+       IF (printlev >= 3) 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
+       IF (printlev >= 3) 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
+    !
+    IF (printlev >= 3) WRITE(numout,*) 'We will work with ', nbind, ' points of the fine grid'
+    !
+    IF (printlev >= 3) 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
+
+
+    IF (printlev >= 3) WRITE(numout,*) ""
+    IF (printlev >= 3) 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
+    !
+    IF (printlev >= 3) 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
+    !
+    IF (printlev >= 3) WRITE(numout,*) 'Domaine LON range : ', domain_minlon, domain_maxlon
+    IF (printlev >= 3) 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
+    !
+    IF (printlev >= 3) WRITE(numout,*) 'We will work with ', nbind, ' points of the fine grid and ', nbpt, 'for the coarse grid'
+    !
+    IF (printlev >= 3) 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)
+    IF (printlev >= 3) WRITE(numout,*) "aggregate_vec : ",not_found_fopt, &
+         & "did not find any corresponding data in the input file."
+    IF (printlev >= 3) WRITE(numout,*) "aggregate_vec : This is ", not_found_fopt/REAL(nbpt, r_std)*100., &
+         & " % of the grid"
+    IF (printlev >= 3) WRITE(numout,*) "aggregate_vec : nbvmax = ",incmax, "max used = ",fopt_max
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (searchind)
+    DEALLOCATE (fine_ind)
+    !
+    ! Close the progress meter
+    !
+    IF (printlev >= 3) 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 ( grid_type == regular_lonlat ) 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 ( grid_type == regular_xy ) THEN
+       IF ( proj_stack(1)%code > undef_int-1 ) THEN
+          CALL ipslerr(3, "aggregate_vec_p", "regular_xy 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.", &
+            &       "Use interpolations with XIOS for unstructured grid","Set XIOS_INTERPOLATION=y in run.def")
+    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 ( grid_type == regular_lonlat ) 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 ( grid_type == regular_xy ) THEN
+       IF ( proj_stack(1)%code > undef_int-1 ) THEN
+          CALL ipslerr(3, "aggregate_2d_p", "Regular_xy 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.", &
+            &       "Use interpolations with XIOS for unstructured grid","Set XIOS_INTERPOLATION=y in run.def")
+    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-AFP/src_global/interpweight.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/interpweight.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/interpweight.f90	(revision 8430)
@@ -0,0 +1,5043 @@
+MODULE interpweight
+!=================================================================================================================================
+! MODULE       : interpweight
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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,Nvariabletypes), 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(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(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(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(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(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(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(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(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(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(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(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(3,'interpweight_get_var2dims_file',TRIM(msg), '', '')
+       END IF
+       
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr(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(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(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(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(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(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(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(3,'interpweight_get_var3dims_file',TRIM(msg), '', '')
+       END IF
+       
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr(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(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(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(3,'interpweight_get_var3dims_file', 'Error in ng90_dimension 3', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr(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(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(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(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(3,'interpweight_get_var4dims_file',TRIM(msg), '', '')
+       END IF
+
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr(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(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(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(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(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(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(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(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(3,'interpweight_get_varNdims_file','Problem with nf90_inquire_variable', &
+            TRIM(nf90_strerror(rcode)), '')
+
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr(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(3,'isin_file','Problem with nf90_open',TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire(nid, Ndims, Nvars)
+       IF (rcode /= NF90_NOERR) CALL ipslerr(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(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(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-AFP/src_global/interregxy.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/interregxy.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/interregxy.f90	(revision 8430)
@@ -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-AFP/src_global/module_llxy.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/module_llxy.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/module_llxy.f90	(revision 8430)
@@ -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-AFP/src_global/polygones.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/polygones.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/polygones.f90	(revision 8430)
@@ -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-AFP/src_global/solar.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/solar.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/solar.f90	(revision 8430)
@@ -0,0 +1,599 @@
+! =================================================================================================================================
+! MODULE       : solar
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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
+    USE time, ONLY : one_year, calendar_str
+
+    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)
+
+!_ ================================================================================================================================
+
+    IF (printlev >= 4) 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 (printlev >= 4) 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 (printlev >= 4) 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 (printlev >= 4) WRITE(numout,*) 'Get time zone', et, gmt
+    CALL time_zone(gmt, iim, jjm, lon, zone, lhour)
+    !-
+    !- Start a loop through the grid
+    !-
+    IF (printlev >= 4) 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,jday,rtime,cloud,nband,solad,solai)
+
+    USE time, ONLY : one_year, calendar_str
+    
+    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
+    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)
+       IF (printlev >= 1) 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)
+       IF (printlev >= 1) 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)
+       IF (printlev >= 1) 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-AFP/src_global/time.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_global/time.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_global/time.f90	(revision 8430)
@@ -0,0 +1,318 @@
+! ================================================================================================================================
+!  MODULE       : time
+!
+!  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 contians the time information for ORCHIDEE
+!!
+!!\n DESCRIPTION: This module contains the time information for ORCHIDEE.
+!! Time variables are calculated and updated at each time step. The variables are public and can be used from other modules.
+!! The time variables must not be modified outside this module. 
+!!
+!! Time variables in this module are given for the interval corresponding to current time-step. 
+!! The variables xxx_start and xxx_end are given to describe the time interval, either on julian(julian_start, julian_end) or 
+!! yymmddsec format (year_start/end, month_start/end, day_start/end, sec_start/end). The variables can be used in all other modules. 
+!! Logical variables telling if it's the last or first time-step of the day, of the month or of the year are also available.  
+!!
+!! Subroutines in module time : 
+!!   time_initialize : To initialize time variables. 
+!!                     Public subroutine called from intersurf_initialize_2d, intersurf_initialize_gathered or orchideedriver.
+!!                     This subroutine is called before the first call to sechiba.
+!!   time_nextstep   : Update time variables in the beginning at each new time step.
+!!                     Public subroutine called from intersurf_main_2d, intersurf_main_gathered or orchideedriver.
+!!   time_interval   : Calculate the interval for a given time step. Local subroutine, called from time_nextstep. 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+MODULE time
+
+  USE defprec
+  USE constantes_var
+  USE mod_orchidee_para_var, ONLY : numout
+  USE ioipsl
+  USE ioipsl_para
+  
+  IMPLICIT NONE
+  PRIVATE
+
+  PUBLIC :: time_initialize, time_nextstep
+
+  REAL(r_std), PUBLIC                 :: dt_sechiba         !! Lenght of time step in sechiba (s)
+!$OMP THREADPRIVATE(dt_sechiba)
+  REAL(r_std), PUBLIC                 :: dt_stomate         !! Length of time step in slow processes in stomate (s)
+!$OMP THREADPRIVATE(dt_stomate)
+  CHARACTER(LEN=20), PUBLIC           :: calendar_str       !! The calendar type
+!$OMP THREADPRIVATE(calendar_str)
+  INTEGER(i_std), SAVE, PUBLIC        :: year_start         !! Year at beginng of current time step
+!$OMP THREADPRIVATE(year_start)
+  INTEGER(i_std), SAVE, PUBLIC        :: month_start        !! Month at beginng of current time step
+!$OMP THREADPRIVATE(month_start)
+  INTEGER(i_std), SAVE, PUBLIC        :: day_start          !! Day in month at beginng of current time step
+!$OMP THREADPRIVATE(day_start)
+  REAL(r_std), SAVE, PUBLIC           :: sec_start          !! Seconds in the day at beginng of current time step
+!$OMP THREADPRIVATE(sec_start)
+  INTEGER(i_std), SAVE, PUBLIC        :: year_end           !! Year at end of current time step
+!$OMP THREADPRIVATE(year_end)
+  INTEGER(i_std), SAVE, PUBLIC        :: month_end          !! Month at end of current time step
+!$OMP THREADPRIVATE(month_end)
+  INTEGER(i_std), SAVE, PUBLIC        :: day_end            !! Day in month at end of current time step
+!$OMP THREADPRIVATE(day_end)
+  REAL(r_std), SAVE, PUBLIC           :: sec_end            !! Seconds in the day at end of current time step
+!$OMP THREADPRIVATE(sec_end)
+  CHARACTER(LEN=6), SAVE, PUBLIC      :: tstepint_type      !! Position of time step in the time interval
+!$OMP THREADPRIVATE(tstepint_type)
+  INTEGER(i_std), PUBLIC              :: month_len          !! Lenght of current month (d)
+!$OMP THREADPRIVATE(month_len)
+  INTEGER(i_std), PRIVATE             :: year_length        !! Lenght of current year in time step (tstp)
+!$OMP THREADPRIVATE(year_length)
+  REAL(r_std), PUBLIC                 :: one_day            !! Lenght of one day in seconds (s)
+!$OMP THREADPRIVATE(one_day)
+  REAL(r_std), PUBLIC                 :: one_year           !! Length of current year in days (d)
+!$OMP THREADPRIVATE(one_year)
+  REAL(r_std), PARAMETER, PUBLIC      :: one_hour = 3600.0  !! Lenght of hour in seconds (s)  
+
+  LOGICAL, PUBLIC                     :: FirstTsYear        !! Flag is true for the first sechiba time step on the year.
+!$OMP THREADPRIVATE(FirstTsYear)
+  LOGICAL, PUBLIC                     :: LastTsYear         !! Flag is true for the last sechiba time step of the year, previously named EndOfYear
+!$OMP THREADPRIVATE(LastTsYear)
+  LOGICAL, PUBLIC                     :: FirstTsMonth       !! Flag is true for the first sechiba time step of the month. 
+!$OMP THREADPRIVATE(FirstTsMonth)
+  LOGICAL, PUBLIC                     :: LastTsMonth        !! Flag is true for the last sechiba time step of the month. 
+!$OMP THREADPRIVATE(LastTsMonth)
+  LOGICAL, PUBLIC                     :: FirstTsDay         !! Flag is true for the first sechiba time step of the day. 
+!$OMP THREADPRIVATE(FirstTsDay)
+  LOGICAL, PUBLIC                     :: LastTsDay          !! Flag is true for the last sechiba time step of the day. 
+!$OMP THREADPRIVATE(LastTsDay)
+  REAL(r_std), SAVE, PUBLIC           :: date0_save         !! Start date of simulation, in juilan calendar
+!$OMP THREADPRIVATE(date0_save)
+  REAL(r_std), PUBLIC                 :: julian_diff        !! Days since the beginning of current year
+!$OMP THREADPRIVATE(julian_diff)
+  REAL(r_std), PUBLIC                 :: julian_start       !! Beginning of the interval for current time step, in juilan calendar
+!$OMP THREADPRIVATE(julian_start)
+  REAL(r_std), PUBLIC                 :: julian_end         !! End of the interval for current time step, in juilan calendar
+!$OMP THREADPRIVATE(julian_end)
+  REAL(r_std), SAVE, PUBLIC           :: julian0            !! First day of this year in julian caledrier
+!$OMP THREADPRIVATE(julian0)
+  INTEGER(i_std), SAVE, PRIVATE       :: printlev_loc       !! Local level of text output for current module
+!$OMP THREADPRIVATE(printlev_loc)
+  
+
+CONTAINS
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    time_initialize()
+!!
+!>\BRIEF	  Initalize time information
+!!
+!! DESCRIPTION:	  Initialize time information. This subroutine is called only in the intialization phase of the model and gives
+!!                the basic information on the calendar and time interval.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE time_initialize(kjit, date0_loc, dt_sechiba_loc, tstepint)
+
+    !! 0.1 Input arguments
+    INTEGER(i_std), INTENT(in)   :: kjit           !! Time step of the restart file
+    REAL(r_std), INTENT(in)      :: date0_loc      !! The date at which kjit=0
+    REAL(r_std), INTENT(in)      :: dt_sechiba_loc !! Time step of sechiba component
+    CHARACTER(LEN=*), INTENT(in) :: tstepint       !! Position of the time stamp: beginning, centre or end of time step 
+                                                   !! Possible values for tstepint : START, CENTER, END
+
+    !! Initialize local printlev variable
+    !! It is not possible here to use the function get_printlev for problems with circular dependecies between modules
+    printlev_loc=printlev
+    CALL getin_p('PRINTLEV_time', printlev_loc)
+
+    !! Save length of sechiba time step in module variable
+    !! Time step for sechiba comes from the atmospheric model or from the 
+    !! offline driver which reads it from parameter DT_SECHIBA
+    dt_sechiba = dt_sechiba_loc
+
+    !! Save tstepint in global variable
+    tstepint_type = tstepint
+    IF (tstepint_type /= "START" .AND. tstepint_type /= "END") THEN
+       WRITE(numout,*) 'Unknown option for time interval, tstepint_type=', tstepint_type
+       CALL ipslerr_p(3,'time_initialize', 'Unknown time iterval type.',&
+            'The time stamp given can have 2 position on the interval :',' START or END')
+    END IF
+
+    !! Save the start date in the module
+    date0_save = date0_loc
+
+    !! Get the calendar from IOIPSL, it is already initialized
+    CALL ioget_calendar(calendar_str)
+
+    !! Get year lenght in days and day lenght in seconds
+    CALL ioget_calendar(one_year, one_day)
+
+    !! Get the number of sechiba time steps for 1 year (for the current year)
+    CALL tlen2itau('1Y', dt_sechiba, date0_save, year_length)
+
+    !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 of STOMATE.
+    !Config Units = [seconds]
+    dt_stomate = one_day
+    CALL getin_p('DT_STOMATE', dt_stomate)
+
+ 
+    IF (printlev_loc >=1) THEN
+       WRITE(numout,*) "time_initialize : calendar_str= ",calendar_str
+       WRITE(numout,*) "time_initialize : dt_sechiba(s)= ",dt_sechiba," dt_stomate(s)= ", dt_stomate
+       WRITE(numout,*) "time_initialize : date0_save= ",date0_save," kjit= ",kjit
+    ENDIF
+    
+    CALL time_nextstep(kjit)
+    
+  END SUBROUTINE time_initialize
+  
+!!  =============================================================================================================================
+!! SUBROUTINE:    time_nextstep()
+!!
+!>\BRIEF	  Update the time information for the next time step.
+!!
+!! DESCRIPTION:	  This subroutine will place in the public variables of the module all the time information
+!!                needed by ORCHIDEE for this new time step.
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE time_nextstep(kjit)
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)   :: kjit       !! Current time step
+
+
+    !! Calculate the new time interval for current time step
+    CALL time_interval(kjit, year_start, month_start, day_start, sec_start, &
+                             year_end,   month_end,   day_end,   sec_end)
+    
+    !! Calculate julian0: the julian date for the 1st of January in current year
+    CALL ymds2ju(year_start,1,1,zero, julian0)
+
+    !! Caluclate julian_diff: The diffrence of the end of current time-step and the beginning of the year in julian days
+    julian_diff = julian_end - julian0
+
+    !! Update variables for year length
+    CALL ioget_calendar(one_year, one_day)
+    CALL tlen2itau('1Y', dt_sechiba, date0_save, year_length)
+
+    !! Calculate number of days in the current month, using the start of the time-interval for current time-step
+    month_len = ioget_mon_len(year_start,month_start)
+
+
+    !! Calculate logical variables true if the current time-step corresponds to the end or beggining of a day, month or year
+    FirstTsDay = .FALSE.
+    FirstTsMonth = .FALSE.
+    FirstTsYear = .FALSE.
+    LastTsDay = .FALSE.
+    LastTsMonth = .FALSE.
+    LastTsYear = .FALSE.
+ 
+    IF (sec_start >= -1 .AND. sec_start < dt_sechiba-1 ) THEN
+       FirstTsDay = .TRUE.
+       IF ( day_start == 1 ) THEN
+          FirstTsMonth = .TRUE.
+          IF ( month_start == 1) THEN
+             FirstTsYear = .TRUE.
+          END IF
+       END IF
+    ELSE IF (sec_start >= one_day-dt_sechiba-1 .AND. sec_start < one_day-1 ) THEN
+       LastTsDay = .TRUE.
+       IF ( day_start == month_len ) THEN
+          LastTsMonth = .TRUE.
+          IF ( month_start == 12) THEN
+             LastTsYear = .TRUE.
+          END IF
+       END IF
+    END IF
+
+
+    !! Write debug information depending on printlev_loc.
+    IF ( ((printlev_loc >= 4) .OR. (printlev_loc >=2 .AND. FirstTsMonth)) .OR. (printlev_loc>=1 .AND. FirstTsYear)) THEN
+       WRITE(numout,*) "time_nextstep: Time interval for time step :", kjit
+       WRITE(numout,"(' time_nextstep: Start of interval         ', I4.4,'-',I2.2,'-',I2.2,' ',F12.4)") &
+            year_start, month_start, day_start, sec_start
+       WRITE(numout,"(' time_nextstep: End of interval           ', I4.4,'-',I2.2,'-',I2.2,' ',F12.4)") &
+            year_end, month_end, day_end, sec_end
+       WRITE(numout,*) "time_nextstep: month_len=",month_len, " one_year=",one_year
+       WRITE(numout,*) ""
+    END IF
+    IF (printlev_loc >= 4) THEN
+       WRITE(numout,*) "time_nextstep: FirstTsDay=", FirstTsDay," FirstTsMonth=",FirstTsMonth," FirstTsYear=", FirstTsYear
+       WRITE(numout,*) "time_nextstep: LastTsDay=", LastTsDay," LastTsMonth=",LastTsMonth," LastTsYear=", LastTsYear
+       WRITE(numout,*) "time_nextstep: julian0=",julian0, " julian_diff=",julian_diff
+       WRITE(numout,*) ""
+    END IF
+    IF ((printlev_loc >= 2) .AND. FirstTsDay) THEN
+       WRITE(numout,"(' Date: ', I4.4,'-',I2.2,'-',I2.2,' ',F8.4,'sec at timestep ',I12.4)") &
+            year_start, month_start, day_start, sec_start, kjit
+    END IF
+
+  END SUBROUTINE time_nextstep
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    time_interval()
+!!
+!>\BRIEF	  Computes the interval corresponging to the given time step.
+!!
+!! DESCRIPTION:	  This subroutine will compute the interval of time for the given time step.
+!!                It will use the tstepint_type variable which was set at initilisation. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE time_interval(kjit, year_s, month_s, day_s, sec_s, &
+                                 year_e, month_e, day_e, sec_e)
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                  :: kjit      !! Current time step
+
+    !! 0.2 Output variables
+    INTEGER(i_std), INTENT(out)                 :: year_s, month_s, day_s
+    INTEGER(i_std), INTENT(out)                 :: year_e, month_e, day_e
+    REAL(r_std), INTENT(out)                    :: sec_s
+    REAL(r_std), INTENT(out)                    :: sec_e
+    
+
+    !! Calculate the interval for current time step
+    !! tstepint_type is used to know how the interval is defined around the time-stamp of the time-step 
+    SELECT CASE (TRIM(tstepint_type))
+       CASE ("START ")
+          !! Calculate the start date of the interval
+          julian_start = itau2date(kjit, date0_save, dt_sechiba)
+          !! Calculate the end date of the interval using kjti+1
+          julian_end = itau2date(kjit+1, date0_save, dt_sechiba)
+       CASE("END")
+          !! Calculate the start date of the interval
+          julian_start = itau2date(kjit-1, date0_save, dt_sechiba)
+          !! Calculate the end date of the interval
+          julian_end = itau2date(kjit, date0_save, dt_sechiba)
+       CASE DEFAULT
+          WRITE(numout,*) "time_interval: tstepint_type = ", tstepint_type
+          CALL ipslerr_p(3,'time_interval', 'Unknown time iterval type.', &
+               'The time stamp given can have 3 position on the interval :',' START, CENTER or END')
+       END SELECT
+
+       !! Calculate year, month, day and sec for julian_start date
+       CALL ju2ymds (julian_start, year_s, month_s, day_s, sec_s)
+
+       !! Calculate year, month, day and sec for julian_end date
+       CALL ju2ymds (julian_end, year_e, month_e, day_e, sec_e)
+
+    
+  END SUBROUTINE time_interval
+
+END MODULE time
Index: /branches/publications/ORCHIDEE-AFP/src_oasisdriver/driver2oasis.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_oasisdriver/driver2oasis.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_oasisdriver/driver2oasis.f90	(revision 8430)
@@ -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-AFP/src_oasisdriver/orchideeoasis.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_oasisdriver/orchideeoasis.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_oasisdriver/orchideeoasis.f90	(revision 8430)
@@ -0,0 +1,928 @@
+! =================================================================================================================================
+! 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
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)          :: veget         !! Fraction of vegetation type (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)          :: lai           !! Leaf area index (m^2 m^{-2}
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:)          :: height        !! Vegetation Height (m)
+  !-
+  !- 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, regular_lonlat, "ForcingGrid")
+  ELSE IF ( model_guess == "WRF") THEN
+     CALL grid_init (nbp_loc, nbseg, regular_xy, "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))
+  ALLOCATE(veget(kjpindex,nvm))
+  ALLOCATE(lai(kjpindex,nvm))
+  ALLOCATE(height(kjpindex,nvm))
+  !
+  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_sechiba = 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)
+  !
+  in_julian = itau2date(itau, date0, dt)
+  CALL ymds2ju (year,1,1,zero, julian0)
+  julian_diff = in_julian-julian0
+
+  CALL xios_orchidee_init( MPI_COMM_ORCH,                    &
+       date0,    year,    month,           day, julian_diff, &
+       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,                  &
+             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, 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, &
+          ! Vegeation, lai and vegetation height
+          & veget, lai, height, &
+          ! 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("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-AFP/src_oasisdriver/orchoasis_tools.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_oasisdriver/orchoasis_tools.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_oasisdriver/orchoasis_tools.f90	(revision 8430)
@@ -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-AFP/src_parallel/AA_make
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/AA_make	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/AA_make	(revision 8430)
@@ -0,0 +1,156 @@
+#-
+#- $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)(constantes_soil_var.o) : ../src_parameters/constantes_soil_var.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ../src_parameters/constantes_soil_var.f90
+	$(A_C) $(PARAM_LIB) constantes_soil_var.o
+	$(A_C) $(ORCHIDEE_LIB) constantes_soil_var.o
+	$(RM) ../src_parallel/constantes_soil_var.o
+
+config : 
+	$(BINDIR)/Fparser -name PARALLEL $(MODS1)
+	echo 'Configuration of PARALLEL done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(mpi_dummy.o):
+
+$(MODEL_LIB)(mod_orchidee_para_var.o):
+
+$(MODEL_LIB)(xios_orchidee.o): \
+       $(MODEL_LIB)(mod_orchidee_para_var.o) \
+       $(MODEL_LIB)(mod_orchidee_transfert_para.o) \
+       $(MODEL_LIB)(ioipsl_para.o) \
+       $(PARAM_LIB)(pft_parameters_var.o) \
+       $(PARAM_LIB)(constantes_var.o) \
+       $(PARAM_LIB)(constantes_soil_var.o)
+
+$(MODEL_LIB)(mod_orchidee_mpi_data.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o) \
+    $(MODEL_LIB)(xios_orchidee.o) 
+
+$(MODEL_LIB)(mod_orchidee_omp_data.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(timer.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(orch_write_field.o): \
+    $(MODEL_LIB)(mod_orchidee_para.o)
+
+$(MODEL_LIB)(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-AFP/src_parallel/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/AA_make.ldef	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/AA_make.ldef	(revision 8430)
@@ -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-AFP/src_parallel/ioipsl_para.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/ioipsl_para.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/ioipsl_para.f90	(revision 8430)
@@ -0,0 +1,967 @@
+! ==============================================================================================================================
+! MODULE   : ioipls_para
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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
+!-
+  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. Need to be call by all process
+  !!
+  !! \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_r2d, restput_p_opp_r1d
+  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_r2d, restget_p_opp_r1d
+  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). Need 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:	 will sets up the domain activity of IOIPSL. Need 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)
+    !!--------------------------------------------------------------------
+    !! The "ipslnlf" routine allows to know and modify
+    !! the current logical number for the messages.
+    !!
+    !! SUBROUTINE ipslnlf (new_number,old_number)
+    !!
+    !! Optional INPUT argument
+    !!
+    !! (I) new_number : new logical number of the file
+    !!
+    !! Optional OUTPUT argument
+    !!
+    !! (I) old_number : current logical number of the file
+    !!--------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+    INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+    !---------------------------------------------------------------------
+    IF (PRESENT(old_number)) THEN
+#ifndef CPP_OMP
+       CALL ipslnlf(old_number=orch_ipslout)
+#endif
+       old_number = orch_ipslout
+    ENDIF
+    IF (PRESENT(new_number)) THEN
+       orch_ipslout = new_number
+#ifndef CPP_OMP
+       CALL ipslnlf(new_number=orch_ipslout)
+#endif
+    ENDIF
+
+  END SUBROUTINE ipslnlf_p
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE:   ipslerr_p
+  !!
+  !>\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
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    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      " /)
+    INTEGER :: ierr
+    !---------------------------------------------------------------------
+    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")')
+       ! Force to pring text output using FLUSH only if cpp flag CPP_FLUSH is set in arch-XXX.fcm
+#ifdef CPP_FLUSH
+       CALL FLUSH(orch_ipslout)
+#endif
+
+#ifdef CPP_PARA
+       CALL MPI_ABORT(MPI_COMM_WORLD, 1, ierr)
+#endif     
+       STOP 1
+    ENDIF
+    !---------------------
+  END SUBROUTINE ipslerr_p
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE:  getin_p_c 
+  !!
+  !>\BRIEF      get a character variable in text input file 	 
+  !!
+  !! DESCRIPTION: Need to be call by all process 	 
+  !!
+  !! \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: Need to be call by all process 
+  !!
+  !! \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: Need to be call by all process 
+  !!
+  !! \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:  Need to be call 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: Need to be call 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: Need to be call by all process 
+  !!
+  !! \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: Need to be call by all process  
+  !!
+  !! \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: Need to be call by all process 
+  !!
+  !! \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: Need to be call by all process
+  !!
+  !! \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: Need to be call by all process
+  !!
+  !! \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 !
+
+    USE grid, ONLY : grid_type, unstructured, ind_cell_glo
+    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
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+       ALLOCATE( temp_g(1) )
+    ENDIF
+
+    IF (grid_type==unstructured) THEN
+ 
+      IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
+      CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
+      IF (is_root_prc)  CALL restget (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+                                      temp_g, MY_OPERATOR, nbindex, ind_cell_glo_glo(ijndex(:)))
+
+    ELSE
+        
+      IF (is_root_prc) 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.  Need to be call by all process
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE restget_p_opp_r2d &
+  (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+
+    USE grid, ONLY : grid_type, unstructured, ind_cell_glo
+    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
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+
+    IF (grid_type==unstructured) THEN
+      IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
+      CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
+      IF (is_root_prc)  CALL restget (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+                                      temp_g, MY_OPERATOR, nbindex, ind_cell_glo_glo(ijndex(:)))
+
+    ELSE
+
+      IF (is_root_prc) CALL restget(fid, vname_q, iim, jjm, llm, itau, def_beha, &
+                                    temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_opp_r2d
+
+!!  =============================================================================================================================
+!! SUBROUTINE:   restget_p_r1d
+!!
+!>\BRIEF	Transform the data (real 1D) from the restart file onto the model grid 	 
+!!
+!! DESCRIPTION:	 do not use this function with non grid variable.  Need to be call by all process
+!! \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 scatter(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.  Need to be call by all process
+!! \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 scatter(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.  Need to be call by all process
+!! \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 scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r3d
+
+!!  =============================================================================================================================
+!! 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:	  Need to be call by all process
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE restput_p_opp_r1d &
+  (fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
+
+    USE grid, ONLY : grid_type, unstructured, ind_cell_glo
+    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
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
+
+    IF (is_root_prc) THEN 
+      ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+      ALLOCATE ( temp_g(1) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+
+    IF (grid_type==unstructured) THEN
+      IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
+      CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
+      IF (is_root_prc) CALL restput(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, &
+                                     nbindex, ind_cell_glo_glo(ijndex(:)))
+    ELSE
+      IF (is_root_prc)  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:	  Need to be call by all process
+!! \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_r1d
+!!
+!>\BRIEF	 allows to re-index data (real 1D) onto the original grid of the restart file
+!!
+!! DESCRIPTION:	 Need to be call by all process
+!!
+!! \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 gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r1d
+
+!!  =============================================================================================================================
+!! SUBROUTINE:   restput_p_r2d
+!!
+!>\BRIEF	 allows to re-index data (real 2D) onto the original grid of the restart file
+!!
+!! DESCRIPTION:	 Need to be call by all process
+!!
+!! \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 gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r2d
+
+!!  =============================================================================================================================
+!! SUBROUTINE:   restput_p_r3d
+!!
+!>\BRIEF	  allows to re-index data (real 3D) onto the original grid of the restart file
+!!
+!! DESCRIPTION:	 Need to be call by all process
+!!
+!! \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(iim,jjm,llm) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r3d
+
+!!  =============================================================================================================================
+!! SUBROUTINE:   histwrite_r1d_p
+!!
+!>\BRIEF   give the data (real 1D) to the IOIPSL system (if we don't use XIOS). 	 
+!!
+!! DESCRIPTION:	 Need to be call by all process
+!!
+!! \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:	 Need to be call by all process
+!!
+!! \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:	 Need to be call by all process
+!!
+!! \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
+  
+    STOP 2 
+    
+  END SUBROUTINE histwrite_r3d_p
+
+
+END MODULE ioipsl_para
Index: /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_mpi_data.F90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_mpi_data.F90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_mpi_data.F90	(revision 8430)
@@ -0,0 +1,558 @@
+! ==============================================================================================================================
+! MODULE   : mod_orchidee_mpi_data
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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_para
+  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
+    LOGICAL :: xios_orchidee_ok     !! Local variable read from run.def
+    
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    ! Read XIOS_ORCHIDEE_OK from run.def. In this module, due to cyclic dependancies 
+    ! the variable can not be used from module xios_orchidee.
+    xios_orchidee_ok=.TRUE.
+    CALL getin('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   : 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)
+#ifdef XIOS
+    USE xios
+#endif
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !!    Output variables
+    INTEGER, INTENT(OUT) :: comm_local
+    CHARACTER(len=*),PARAMETER      :: id="client"           !! Id for initialization of ORCHIDEE in XIOS
+
+    !_ ================================================================================================================================
+
+    IF (is_omp_root) THEN
+#ifdef XIOS
+       CALL xios_initialize(id,return_comm=comm_local)
+#else
+       ! Write error messages and stop the model
+       WRITE(numout,*) 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS'
+       WRITE(numout,*) 'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def'
+       WRITE(numout,*) 'Fatal error from ORCHIDEE. STOP in xios_orchidee_comm_init'
+#ifdef CPP_PARA
+       CALL MPI_ABORT(3)
+#endif     
+       STOP 1       
+#endif
+    
+    END IF
+  END SUBROUTINE xios_orchidee_comm_init
+  
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_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
+#ifdef XIOS
+  USE xios, ONLY : xios_context_finalize, xios_finalize
+#endif
+    LOGICAL :: xios_orchidee_ok ! Local variable read from run.def 
+
+    ! Read XIOS_ORCHIDEE_OK from run.def. In this module, due to cyclic dependancies 
+    ! the variable can not be used from module xios_orchidee.
+    xios_orchidee_ok=.TRUE.
+    IF (is_omp_root) CALL getin('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+       CALL xios_context_finalize()
+       CALL xios_finalize()
+#endif
+    END IF
+  END SUBROUTINE xios_orchidee_finalize
+  
+
+
+  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 is enough land grid cells on each process MPI.
+    ! 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 < 1 ) THEN
+       PRINT*,'Init_orchidee_mpi_data: nbp_mpi(number of grid-cells for current MPI process)=',arg_nbp_mpi
+       PRINT*,'nbp_mpi=0 is not possible. It must be 1 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.","")
+    ELSE IF (arg_nbp_mpi == 1 .AND. mpi_size > 1) THEN
+       CALL ipslerr_p(1, "Init_orchidee_mpi_data","nbp=1 for current MPI process",&
+            "This can be a problem in some case.", &
+            "If the model crashes, then 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)
+    
+    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-AFP/src_parallel/mod_orchidee_mpi_transfert.F90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_mpi_transfert.F90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_mpi_transfert.F90	(revision 8430)
@@ -0,0 +1,4046 @@
+! ==============================================================================================================================
+! MODULE   : mod_orchidee_mpi_transfert
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
+          scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE   : gather_mpi_s
+  !!
+  !>\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_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
+          gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
+  END INTERFACE
+
+  INTERFACE scatter_unindexed_mpi
+     MODULE PROCEDURE scatter_unindexed_mpi_i,scatter_unindexed_mpi_i1,scatter_unindexed_mpi_i2,scatter_unindexed_mpi_i3, &
+          scatter_unindexed_mpi_r,scatter_unindexed_mpi_r1,scatter_unindexed_mpi_r2,scatter_unindexed_mpi_r3, &
+          scatter_unindexed_mpi_l,scatter_unindexed_mpi_l1,scatter_unindexed_mpi_l2,scatter_unindexed_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather_unindexed_mpi
+     MODULE PROCEDURE gather_unindexed_mpi_i,gather_unindexed_mpi_i1,gather_unindexed_mpi_i2,gather_unindexed_mpi_i3, &
+          gather_unindexed_mpi_r,gather_unindexed_mpi_r1,gather_unindexed_mpi_r2,gather_unindexed_mpi_r3, &
+          gather_unindexed_mpi_l,gather_unindexed_mpi_l1,gather_unindexed_mpi_l2,gather_unindexed_mpi_l3  
+  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_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_r1
+
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r3
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l1
+
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition 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
+
+!!!!! --> 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
+
+!!!!! --> 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
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter_unindexed   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_unindexed_mpi_igen(dummy,Varout,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_i
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_igen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_i1
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_i2
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_i3
+
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_unindexed_mpi_rgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_r
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_r1
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_r2
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_r3
+
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_unindexed_mpi_lgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_l
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_l1
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_l2
+
+  SUBROUTINE scatter_unindexed_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_unindexed_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_unindexed_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_unindexed_mpi_l3
+
+
+
+
+
+
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_unindexed_mpi_igen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_i
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_unindexed_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_i1
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_unindexed_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_unindexed_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_unindexed_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_unindexed_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_r1
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_unindexed_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_unindexed_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_unindexed_mpi_lgen(VarIn,dummy,1,1)      
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_unindexed_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_l1
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_unindexed_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_unindexed_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_unindexed_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_unindexed_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_unindexed_mpi_l3
+
+
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! 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_scatter_unindexed_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(ij_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_g*jjm_g) :: 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=ij_para_nb(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(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_scatter_unindexed_mpi_igen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_unindexed_mpi_igen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,ij_nb*dimsize,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_unindexed_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_unindexed_mpi_igen
+
+SUBROUTINE orch_scatter_unindexed_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(ij_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_g*jjm_g) :: 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=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(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_scatter_unindexed_mpi_rgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_unindexed_mpi_rgen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,ij_nb*dimsize,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_unindexed_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_unindexed_mpi_rgen
+
+SUBROUTINE orch_scatter_unindexed_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(ij_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_g*jjm_g) :: 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=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(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_scatter_unindexed_mpi_lgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_unindexed_mpi_lgen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,ij_nb*dimsize,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_unindexed_mpi_lgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_unindexed_mpi_lgen
+
+
+SUBROUTINE orch_gather_unindexed_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(ij_nb,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*iim_g*jjm_g) :: 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=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_gather_unindexed_mpi_igen ij_para_nb, displs, counts,Index_Para-1",&
+          ij_para_nb, displs, counts,Index_Para-1
+
+  ENDIF
+
+  CALL MPI_GATHERV(VarIn,ij_nb*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=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_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_unindexed_mpi_igen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_unindexed_mpi_igen
+
+
+SUBROUTINE orch_gather_unindexed_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(ij_nb,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*iim_g*jjm_g) :: 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=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_gather_unindexed_mpi_rgen ij_para_nb, displs, counts,Index_Para-1",&
+          ij_para_nb, displs, counts,Index_Para-1
+
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_gather_unindexed_mpi_rgen VarIn=",VarIn    
+  CALL MPI_GATHERV(VarIn,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather_unindexed_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp
+
+  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)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_unindexed_mpi_rgen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_unindexed_mpi_rgen
+
+SUBROUTINE orch_gather_unindexed_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(ij_nb,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*iim_g*jjm_g) :: 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=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_gather_unindexed_mpi_lgen ij_para_nb, displs, counts,Index_Para-1",&
+          ij_para_nb, displs, counts,Index_Para-1
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_gather_unindexed_mpi_lgen VarIn=",VarIn    
+  CALL MPI_GATHERV(VarIn,ij_nb*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather_unindexed_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp
+
+  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)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_unindexed_mpi_lgen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_unindexed_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-AFP/src_parallel/mod_orchidee_omp_data.F90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_omp_data.F90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_omp_data.F90	(revision 8430)
@@ -0,0 +1,350 @@
+! ===============================================================================================================================
+! MODULE       : mod_orchidee_omp_data
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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,kindex, arg_offset_omp,last)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: arg_omp_size
+    INTEGER, INTENT(IN) :: arg_omp_rank
+    INTEGER, INTENT(IN) :: arg_nbp_omp
+    INTEGER, INTENT(IN) :: kindex(arg_nbp_omp)
+    INTEGER, INTENT(IN) :: arg_offset_omp
+    LOGICAL, INTENT(IN) :: last
+    
+    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))
+      ALLOCATE(ij_omp_para_nb(0:omp_size-1))
+      ALLOCATE(ij_omp_para_begin(0:omp_size-1))
+      ALLOCATE(ij_omp_para_end(0:omp_size-1))
+    ENDIF
+    
+    CALL barrier2_omp()
+    offset_omp=arg_offset_omp          
+
+    nbp_omp_para_nb(omp_rank)=arg_nbp_omp
+    ij_omp_para_begin(omp_rank)=offset_omp+1
+    IF (last) THEN
+      ij_omp_para_end(omp_rank)=iim_g*jjm_g
+    ELSE
+      ij_omp_para_end(omp_rank)=kindex(arg_nbp_omp)+offset_omp
+    ENDIF
+    ij_omp_para_nb(omp_rank)=ij_omp_para_end(omp_rank)-ij_omp_para_begin(omp_rank)+1
+    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
+       ij_omp_para_begin(:) = ij_omp_para_begin(:)-offset_omp
+       ij_omp_para_end(:) = ij_omp_para_end(:)-offset_omp
+    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)
+
+    ij_omp_nb=ij_omp_para_nb(omp_rank)
+    ij_omp_begin=ij_omp_para_begin(omp_rank)
+    ij_omp_end=ij_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
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER iter
+    LOGICAL, PARAMETER :: check=.TRUE.
+    INTEGER, PARAMETER :: iter_max=1
+    INTEGER, PARAMETER :: print_iter=1
+    INTEGER            :: ierr
+
+    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(MPI_COMM_WORLD, 1, ierr)
+#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-AFP/src_parallel/mod_orchidee_omp_transfert.F90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_omp_transfert.F90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_omp_transfert.F90	(revision 8430)
@@ -0,0 +1,3168 @@
+! ==============================================================================================================================
+! MODULE   : mod_orchidee_omp_transfert
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
+          scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
+  END INTERFACE
+
+  !! ==============================================================================================================================
+  !! INTERFACE   : gather_omp
+  !!
+  !>\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 scatter_unindexed_omp
+     MODULE PROCEDURE scatter_unindexed_omp_i,scatter_unindexed_omp_i1,scatter_unindexed_omp_i2,scatter_unindexed_omp_i3, &
+          scatter_unindexed_omp_r,scatter_unindexed_omp_r1,scatter_unindexed_omp_r2,scatter_unindexed_omp_r3, &
+          scatter_unindexed_omp_l,scatter_unindexed_omp_l1,scatter_unindexed_omp_l2,scatter_unindexed_omp_l3
+  END INTERFACE
+
+
+  INTERFACE gather_unindexed_omp
+     MODULE PROCEDURE gather_unindexed_omp_i,gather_unindexed_omp_i1,gather_unindexed_omp_i2,gather_unindexed_omp_i3, &
+          gather_unindexed_omp_r,gather_unindexed_omp_r1,gather_unindexed_omp_r2,gather_unindexed_omp_r3, &
+          gather_unindexed_omp_l,gather_unindexed_omp_l1,gather_unindexed_omp_l2,gather_unindexed_omp_l3  
+  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, scatter_unindexed_omp, gather_unindexed_omp
+
+CONTAINS
+
+  SUBROUTINE check_buffer_c(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 72 
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+    IF (is_omp_root) THEN
+       IF (buff_size>size_c) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_cbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_cbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_cbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_cbuffer)) DEALLOCATE(omp_cbuffer)
+          size_c=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_c
+             ELSE
+               WRITE(*,*) size_c
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_cbuffer(size_c))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_c
+
+  SUBROUTINE check_buffer_i(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 1 
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_i) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_ibuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_ibuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_ibuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_ibuffer)) DEALLOCATE(omp_ibuffer)
+          size_i=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_i
+             ELSE
+               WRITE(*,*) size_i
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_ibuffer(size_i))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 2
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_r) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_rbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_rbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_rbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_rbuffer)) DEALLOCATE(omp_rbuffer)
+          size_r=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_r
+             ELSE
+               WRITE(*,*) size_r
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_rbuffer(size_r))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 3
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_l) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_lbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_lbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_lbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_lbuffer)) DEALLOCATE(omp_lbuffer)
+          size_l=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_l
+             ELSE
+               WRITE(*,*) size_l
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_lbuffer(size_l))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_l
+    
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(Var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=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
+
+  !! -- Les entiers -- !!
+
+  SUBROUTINE bcast_omp_i(var1)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var1
+
+    INTEGER,DIMENSION(1) :: Var
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 5
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var(1)=Var1
+    CALL check_buffer_i(1)
+    CALL orch_bcast_omp_igen(Var,1,omp_ibuffer)
+    Var1=Var(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i
+
+  SUBROUTINE bcast_omp_i1(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 6
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i1
+
+  SUBROUTINE bcast_omp_i2(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 7
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i2
+
+  SUBROUTINE bcast_omp_i3(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 8
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i3
+
+  SUBROUTINE bcast_omp_i4(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 9
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i4
+
+
+  !! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+    REAL,DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=10
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_r(1)
+    CALL orch_bcast_omp_rgen(Var1,1,omp_rbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r
+
+  SUBROUTINE bcast_omp_r1(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=11
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r1
+
+  SUBROUTINE bcast_omp_r2(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=12
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r2
+
+  SUBROUTINE bcast_omp_r3(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=13
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r3
+
+  SUBROUTINE bcast_omp_r4(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=14
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r4
+
+  !! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+
+    LOGICAL,DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=15
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_l(1)
+    CALL orch_bcast_omp_lgen(Var1,1,omp_lbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l
+
+  SUBROUTINE bcast_omp_l1(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=16
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l1
+
+  SUBROUTINE bcast_omp_l2(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=17
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l2
+
+  SUBROUTINE bcast_omp_l3(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=18
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l3
+
+  SUBROUTINE bcast_omp_l4(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=19
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=20
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=21
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i1
+
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=22
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i2
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=23
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i3
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=24
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=25
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r1
+
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=26
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r2
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=27
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r3
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=28
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=29
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l1
+
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=30
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l2
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=31
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_lbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_unindexed_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_unindexed_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_unindexed_omp_i
+
+  SUBROUTINE scatter_unindexed_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_unindexed_omp_igen(VarIn,Varout,SIZE(VarOut,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_unindexed_omp_i1
+
+  SUBROUTINE scatter_unindexed_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_unindexed_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_unindexed_omp_i2
+
+  SUBROUTINE scatter_unindexed_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_unindexed_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_unindexed_omp_i3
+
+
+  SUBROUTINE scatter_unindexed_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_unindexed_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_unindexed_omp_r
+
+  SUBROUTINE scatter_unindexed_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_unindexed_omp_rgen(VarIn,Varout,SIZE(VarOut,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_unindexed_omp_r1
+
+  SUBROUTINE scatter_unindexed_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_unindexed_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_unindexed_omp_r2
+
+  SUBROUTINE scatter_unindexed_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_unindexed_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_unindexed_omp_r3
+
+
+  SUBROUTINE scatter_unindexed_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_unindexed_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_unindexed_omp_l
+
+  SUBROUTINE scatter_unindexed_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_unindexed_omp_lgen(VarIn,Varout,SIZE(VarOut,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_unindexed_omp_l1
+
+  SUBROUTINE scatter_unindexed_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_unindexed_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_unindexed_omp_l2
+
+  SUBROUTINE scatter_unindexed_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_unindexed_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_unindexed_omp_l3
+  
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather_omp_i0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)               :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=32
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_simple_igen(VarIn,Varout,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i0
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=33
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=34
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=35
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i2
+
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=36
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i3
+
+  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
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_omp_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN)               :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=37
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_simple_rgen(VarIn,Varout,omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r0
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=38
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=39
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=40
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r2
+
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=41
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r3
+
+
+  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
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_omp_l0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN)               :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=42
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_simple_lgen(VarIn,Varout,omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l0
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=43
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=44
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=45
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l2
+
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=46
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l3
+
+  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 des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_unindexed_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_unindexed_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_unindexed_omp_i
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_omp_igen(VarIn,Varout,SIZE(VarIn,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_unindexed_omp_i1
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_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_unindexed_omp_i2
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_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_unindexed_omp_i3
+
+!!!!! --> Les reels
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_unindexed_omp_r
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_omp_rgen(VarIn,Varout,SIZE(VarIn,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_unindexed_omp_r1
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_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_unindexed_omp_r2
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_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_unindexed_omp_r3
+
+!!!!! --> Les booleen
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_unindexed_omp_l
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_omp_lgen(VarIn,Varout,SIZE(VarIn,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_unindexed_omp_l1
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_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_unindexed_omp_l2
+
+
+  SUBROUTINE gather_unindexed_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_unindexed_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_unindexed_omp_l3
+
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=47
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut=VarIn
+    RETURN
+#else
+    CALL check_buffer_i(1)   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=48
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif   
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i1
+
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=49
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i2
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=50
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i3
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=51
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=52
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut=VarIn
+    RETURN
+#else
+    CALL check_buffer_r(1)   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=53
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif   
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r1
+
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=54
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r2
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=55
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r3
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=56
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r4
+
+END MODULE mod_orchidee_omp_transfert
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+#ifdef CPP_OMP
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE orch_bcast_omp_cgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_omp_transfert, ONLY : size_min
+
+  IMPLICIT NONE
+  INTEGER,INTENT(IN)              :: Nb 
+  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Var
+  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER :: i
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=57
+    CALL print_omp_function()
+  ENDIF
+
+  IF (check) THEN
+     IF (numout_omp > 0) THEN
+        WRITE(numout_omp,*) "orch_bcast_omp_cgen before bcast Var",Var
+     ELSE
+        WRITE(*,*) "orch_bcast_omp_cgen before bcast Var",Var
+     ENDIF
+  ENDIF
+
+  IF (is_omp_root) THEN
+     IF ( len(Var) > size_min ) &
+          CALL ipslerr (3,'orch_bcast_omp_cgen', &
+          &          'Error with omp_cbuffer.', 'len(Var) > size_min', &
+          &          '(Increase size_min in mod_orchidee_omp_transfert.)')
+     DO i=1,Nb
+        Buff(i)=TRIM(Var(i))
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+  CALL barrier2_omp()
+      
+  IF (check) THEN
+     IF (numout_omp > 0) THEN
+        WRITE(numout_omp,*) "orch_bcast_omp_cgen after bcast Var",Var
+     ELSE
+        WRITE(*,*) "orch_bcast_omp_cgen after bcast Var",Var
+     ENDIF
+  ENDIF
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_cgen
+
+
+
+SUBROUTINE orch_bcast_omp_igen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb  
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=58
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_igen
+
+
+
+SUBROUTINE orch_bcast_omp_rgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+  REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=59
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_rgen
+
+
+
+SUBROUTINE orch_bcast_omp_lgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=60
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_lgen
+
+
+
+SUBROUTINE orch_scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=61
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_igen
+
+
+SUBROUTINE orch_scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=62
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_rgen
+
+
+SUBROUTINE orch_scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=63
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_lgen
+
+
+
+SUBROUTINE orch_gather_omp_simple_igen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN)                            :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  Buff(omp_rank)=VarIn
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=64
+    CALL print_omp_function()
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_igen
+
+SUBROUTINE orch_gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=65
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_igen
+
+
+SUBROUTINE orch_gather_omp_simple_rgen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  REAL,INTENT(IN)                            :: VarIn
+  REAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=66
+    CALL print_omp_function()
+  ENDIF
+
+  Buff(omp_rank)=VarIn
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_rgen
+
+
+SUBROUTINE orch_gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=67
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_rgen
+
+
+SUBROUTINE orch_gather_omp_simple_lgen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  LOGICAL,INTENT(IN)                            :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=68
+    CALL print_omp_function()
+  ENDIF
+
+  Buff(omp_rank)=VarIn
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_lgen
+
+
+SUBROUTINE orch_gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=69
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_lgen
+
+
+SUBROUTINE orch_scatter_unindexed_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_para_var, ONLY : ij_nb 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(ij_nb,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(ij_omp_nb,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(ij_nb,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,ij_nb
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,ij_omp_nb
+        VarOut(ij,i)=Buff(ij_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_unindexed_omp_igen
+
+
+SUBROUTINE orch_scatter_unindexed_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : ij_nb 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(ij_nb,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(ij_omp_nb,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(ij_nb,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,ij_nb
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,ij_omp_nb
+        VarOut(ij,i)=Buff(ij_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_unindexed_omp_rgen
+
+
+SUBROUTINE orch_scatter_unindexed_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : ij_nb 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(ij_nb,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(ij_omp_nb,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(ij_nb,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,ij_nb
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,ij_omp_nb
+        VarOut(ij,i)=Buff(ij_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_unindexed_omp_lgen
+
+
+
+
+SUBROUTINE orch_gather_unindexed_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : ij_nb 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(ij_omp_nb,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(ij_nb,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(ij_nb,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,ij_omp_nb
+        Buff(ij_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,ij_nb
+           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_unindexed_omp_igen
+
+
+
+
+
+SUBROUTINE orch_gather_unindexed_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : ij_nb 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(ij_omp_nb,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(ij_nb,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(ij_nb,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,ij_omp_nb
+        Buff(ij_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,ij_nb
+           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_unindexed_omp_rgen
+
+
+
+SUBROUTINE orch_gather_unindexed_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : ij_nb 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(ij_omp_nb,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(ij_nb,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(ij_nb,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,ij_omp_nb
+        Buff(ij_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,ij_nb
+           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_unindexed_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-AFP/src_parallel/mod_orchidee_para.F90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_para.F90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_para.F90	(revision 8430)
@@ -0,0 +1,319 @@
+! ==============================================================================================================================
+! MODULE   : mod_orchidee_para
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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(:)
+    LOGICAL                   :: last
+    INTEGER                   :: mpi_size
+    INTEGER                   :: mpi_rank
+    INTEGER                   :: ierr
+        
+#ifdef CPP_PARA
+    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
+    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
+#else
+    mpi_rank=0
+    mpi_size=1
+#endif
+    
+    offset=arg_offset 
+    last=.FALSE.
+    IF (mpi_rank==mpi_size .AND. arg_omp_rank==arg_omp_size) last=.TRUE.
+    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,kindex, offset,last)
+    
+    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-AFP/src_parallel/mod_orchidee_para_var.F90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_para_var.F90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_para_var.F90	(revision 8430)
@@ -0,0 +1,264 @@
+! ================================================================================================================================
+!  MODULE       : mod_orchidee_para_var
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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,DIMENSION(:),ALLOCATABLE :: ij_omp_para_nb
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: ij_omp_para_begin
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: ij_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
+
+  INTEGER(i_std),SAVE :: ij_omp_nb
+  INTEGER(i_std),SAVE :: ij_omp_begin
+  INTEGER(i_std),SAVE :: ij_omp_end
+  !$OMP  THREADPRIVATE(nbp_omp,nbp_omp_begin,nbp_omp_end,offset_omp)
+  !$OMP  THREADPRIVATE(ij_omp_nb,ij_omp_begin,ij_omp_end)
+
+  ! 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
+  !-
+  !! Fraction of continents
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE      :: contfrac_g  
+  !
+END MODULE mod_orchidee_para_var
Index: /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_transfert_para.F90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_transfert_para.F90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/mod_orchidee_transfert_para.F90	(revision 8430)
@@ -0,0 +1,1252 @@
+! ===============================================================================================================================
+! MODULE       : mod_orchidee_transfert_para
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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$
+!! $Date$
+!! $Revision$
+!! \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_r,scatter_r1,scatter_r2,scatter_r3, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3
+  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_r,gather_r1,gather_r2,gather_r3, &
+		     gather_l,gather_l1,gather_l2,gather_l3  
+  END INTERFACE
+  
+  INTERFACE scatter_unindexed
+    MODULE PROCEDURE scatter_unindexed_i,scatter_unindexed_i1,scatter_unindexed_i2,scatter_unindexed_i3, &
+                     scatter_unindexed_r,scatter_unindexed_r1,scatter_unindexed_r2,scatter_unindexed_r3, &
+		     scatter_unindexed_l,scatter_unindexed_l1,scatter_unindexed_l2,scatter_unindexed_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_unindexed
+    MODULE PROCEDURE gather_unindexed_i,gather_unindexed_i1,gather_unindexed_i2,gather_unindexed_i3, &
+                     gather_unindexed_r,gather_unindexed_r1,gather_unindexed_r2,gather_unindexed_r3, &
+		     gather_unindexed_l,gather_unindexed_l1,gather_unindexed_l2,gather_unindexed_l3  
+  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
+!!x
+!! \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_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition 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
+
+
+!!!!! --> 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
+
+
+!!!!! --> 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
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des scatter_unindexed   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+ SUBROUTINE scatter_unindexed_i(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(ij_nb) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_i
+
+
+  SUBROUTINE scatter_unindexed_i1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_i1
+
+
+  SUBROUTINE scatter_unindexed_i2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_i2
+
+
+  SUBROUTINE scatter_unindexed_i3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_unindexed_i3
+
+
+  SUBROUTINE scatter_unindexed_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(ij_nb) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_r
+
+
+  SUBROUTINE scatter_unindexed_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_r1
+
+
+  SUBROUTINE scatter_unindexed_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_r2
+
+
+  SUBROUTINE scatter_unindexed_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_unindexed_r3
+  
+  
+
+  SUBROUTINE scatter_unindexed_l(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(ij_nb) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_l
+
+
+  SUBROUTINE scatter_unindexed_l1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_l1
+
+
+  SUBROUTINE scatter_unindexed_l2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_unindexed_l2
+
+
+  SUBROUTINE scatter_unindexed_l3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(ij_nb,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_unindexed_mpi(VarIn,Var_tmp)
+    CALL scatter_unindexed_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_unindexed_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des gather_unindexed   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_unindexed_i(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(ij_nb) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,Varout)
+  
+  END SUBROUTINE gather_unindexed_i
+
+
+  SUBROUTINE gather_unindexed_i1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,Varout)
+
+  
+  END SUBROUTINE gather_unindexed_i1
+
+
+  SUBROUTINE gather_unindexed_i2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_unindexed_i2
+
+
+  SUBROUTINE gather_unindexed_i3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+
+  
+  END SUBROUTINE gather_unindexed_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_unindexed_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(ij_nb) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE gather_unindexed_r
+
+
+  SUBROUTINE gather_unindexed_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+
+  
+  END SUBROUTINE gather_unindexed_r1
+
+
+  SUBROUTINE gather_unindexed_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_unindexed_r2
+
+
+  SUBROUTINE gather_unindexed_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_unindexed_r3
+
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather_unindexed_l(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(ij_nb) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_unindexed_l
+
+
+  SUBROUTINE gather_unindexed_l1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_unindexed_l1
+
+
+  SUBROUTINE gather_unindexed_l2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_unindexed_l2
+
+
+  SUBROUTINE gather_unindexed_l3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(ij_nb,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_unindexed_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_unindexed_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_unindexed_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! 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-AFP/src_parallel/mpi_dummy.h
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/mpi_dummy.h	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/mpi_dummy.h	(revision 8430)
@@ -0,0 +1,78 @@
+! ==============================================================================================================================
+! INCLUDE    : mpi_dummy.h
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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-AFP/src_parallel/orch_write_field.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/orch_write_field.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/orch_write_field.f90	(revision 8430)
@@ -0,0 +1,319 @@
+! ==============================================================================================================================
+! MODULE   : orch_Write_Field
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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-AFP/src_parallel/orch_write_field_p.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/orch_write_field_p.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/orch_write_field_p.f90	(revision 8430)
@@ -0,0 +1,193 @@
+! ==============================================================================================================================
+! MODULE   : orch_Write_Field_p
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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-AFP/src_parallel/src_parallel.h
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/src_parallel.h	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/src_parallel.h	(revision 8430)
@@ -0,0 +1,663 @@
+! ==============================================================================================================================
+! INCLUDE   : src_parallel.h
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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-AFP/src_parallel/timer.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/timer.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/timer.f90	(revision 8430)
@@ -0,0 +1,277 @@
+! ==============================================================================================================================
+! MODULE   : timer
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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-AFP/src_parallel/xios_orchidee.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parallel/xios_orchidee.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parallel/xios_orchidee.f90	(revision 8430)
@@ -0,0 +1,1141 @@
+! ================================================================================================================================
+!  MODULE       : xios_orchidee
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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, nscm, diaglev, check_cwrr, ok_freeze_cwrr
+  USE time, ONLY : dt_sechiba
+  USE vertical_soil_var, ONLY : ngrnd, nslm
+  USE IOIPSL, ONLY : ioget_calendar, ju2ymds
+  USE mod_orchidee_para_var
+  USE mod_orchidee_transfert_para
+  USE ioipsl_para
+
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC :: xios_orchidee_init, xios_orchidee_change_context, &
+            xios_orchidee_update_calendar, xios_orchidee_context_finalize, xios_orchidee_finalize, &
+            xios_orchidee_close_definition, &
+            xios_orchidee_send_field, xios_orchidee_recv_field, &
+            xios_orchidee_set_file_attr, xios_orchidee_set_field_attr, xios_orchidee_set_fieldgroup_attr, xios_orchidee_setvar
+
+
+  !
+  !! Declaration of public variables
+  !
+  LOGICAL, PUBLIC, SAVE           :: xios_orchidee_ok=.TRUE.     !! Use XIOS for diagnostic files
+  !$OMP THREADPRIVATE(xios_orchidee_ok)
+  LOGICAL, PUBLIC, SAVE           :: xios_interpolation          !! Do reading and interpolations with XIOS. If false, reading will be done with IOIOSL and interpolation using aggregate_p
+  !$OMP THREADPRIVATE(xios_interpolation)
+
+  REAL(r_std), PUBLIC, SAVE       :: xios_default_val=0          !! Default value (missing value) used in XIOS. The value 0 will be overwritten with the value taken from XIOS.
+  !$OMP THREADPRIVATE(xios_default_val)
+
+  !
+  !! Declaration of internal variables
+  !
+#ifdef XIOS
+  TYPE(xios_context)              :: ctx_hdl_orchidee      !! Handel for ORCHIDEE
+  !$OMP THREADPRIVATE(ctx_hdl_orchidee)
+#endif
+
+
+
+  !! ==============================================================================================================================
+  !! 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
+
+  INTERFACE xios_orchidee_recv_field
+     MODULE PROCEDURE xios_orchidee_recv_field_r1d, xios_orchidee_recv_field_r2d, xios_orchidee_recv_field_r3d
+  END INTERFACE
+
+
+CONTAINS
+
+
+  !! ==============================================================================================================================
+  !! 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, julian_diff, &
+       lon_mpi,  lat_mpi,   soilth_lev )
+
+    USE grid, ONLY : grid_type, unstructured, regular_lonlat, regular_xy, nvertex, &
+                     longitude, latitude, bounds_lon, bounds_lat, ind_cell_glo
+    IMPLICIT NONE
+    !
+    !! 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), INTENT(in)                               :: julian_diff      !! Current day in the year [1,365(366)]
+    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
+
+    REAL(r_std),ALLOCATABLE        :: longitude_mpi(:), latitude_mpi(:)
+    REAL(r_std),ALLOCATABLE        :: bounds_lon_mpi(:,:),bounds_lat_mpi(:,:) 
+    INTEGER(i_std),ALLOCATABLE     :: ind_cell_mpi(:) 
+    !_ ================================================================================================================================
+    
+    
+    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)
+    IF (printlev>=1) 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
+
+
+
+    IF (xios_orchidee_ok) THEN
+      !Config Key   = XIOS_INTERPOLATION
+      !Config Desc  = Actiave reading and intrepolation using XIOS
+      !Config If    = XIOS_ORCHIDEE_OK
+      !Config Def   = n
+      !Config Help  = This flag allows the user to decide to use xios
+      !Config         interpolation or standard method for reading input files
+      !Config Units = [FLAG]
+      xios_interpolation = .FALSE.
+      CALL getin_p('XIOS_INTERPOLATION', xios_interpolation)
+   ELSE
+      ! Deactivate interpolation with XIOS not possible wihtout having
+      ! xios_orchidee_ok=true
+      xios_interpolation = .FALSE.
+   END IF
+
+   ! Force xios_interpolation=.TRUE. if using unstructured grid
+   IF (grid_type==unstructured .AND. .NOT. xios_interpolation) THEN
+      WRITE(numout,*) 'xios_interpolation must be true for unstructured grid. It is now changed to true.'
+      xios_interpolation=.TRUE.
+   END IF
+   IF (printlev>=1) WRITE(numout,*)'In xios_orchidee_init, xios_interpolation=', xios_interpolation
+
+
+    !
+    !! 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 (grid_type==unstructured) THEN
+      IF (is_omp_root) THEN
+        ALLOCATE(longitude_mpi(ij_nb))
+        ALLOCATE(latitude_mpi(ij_nb))
+        ALLOCATE(bounds_lon_mpi(ij_nb,nvertex))
+        ALLOCATE(bounds_lat_mpi(ij_nb,nvertex))
+        ALLOCATE(ind_cell_mpi(ij_nb))
+      ELSE
+        ALLOCATE(longitude_mpi(0))
+        ALLOCATE(latitude_mpi(0))
+        ALLOCATE(bounds_lon_mpi(0,0))
+        ALLOCATE(bounds_lat_mpi(0,0))
+        ALLOCATE(ind_cell_mpi(0))
+      ENDIF
+      
+      CALL gather_unindexed_omp(longitude,longitude_mpi)
+      CALL gather_unindexed_omp(latitude,latitude_mpi)
+      CALL gather_unindexed_omp(bounds_lon,bounds_lon_mpi)
+      CALL gather_unindexed_omp(bounds_lat,bounds_lat_mpi)
+      CALL gather_unindexed_omp(ind_cell_glo,ind_cell_mpi)
+    ENDIF
+    
+    
+    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
+       !
+       IF (grid_type==regular_lonlat) THEN
+          ! Global domain
+          CALL xios_set_domain_attr("domain_landpoints", ni_glo=iim_g, nj_glo=jjm_g)
+          ! Local MPI domain
+          CALL xios_set_domain_attr("domain_landpoints",type="rectilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
+          
+          ! Define how data is stored on memory : 1D array for only continental points
+          CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
+          CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)     
+          
+          ! Define longitudes and latitudes on local MPI domain
+          CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=lon_mpi(:,1),latvalue_1d=lat_mpi(1,:))
+          
+       ELSE IF (grid_type==regular_xy ) THEN
+          ! Case not yet fully implemented
+          CALL ipslerr_p(3,'xios_orchidee_init', 'Implemention for grid_type=regular_xy is not finalized',&
+               'Initialization of the domain must be looked over in the code', '')
+
+! Following was done in previous version for case grid_type=regular_xy
+!         ! Local MPI domain
+!          CALL xios_set_domain_attr("domain_landpoints",type="curvilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
+!
+!          ! Define how data is stored on memory : 1D array for only continental points
+!          CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
+!          CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)     
+!
+!          ! Define longitudes and latitudes on local MPI domain depending on grid_type
+!          CALL xios_set_domain_attr("domain_landpoints",lonvalue_2d=lon_mpi,latvalue_2d=lat_mpi)
+
+       ELSE IF (grid_type==unstructured) THEN
+          
+          ! Global domain
+          CALL xios_set_domain_attr("domain_landpoints", ni_glo=jjm_g, type="unstructured", nvertex=nvertex)
+          ! Local MPI domain
+          CALL xios_set_domain_attr("domain_landpoints", ibegin=ij_begin-1, ni=ij_nb)
+          
+          ! Define how data is stored on memory : 1D array for only continental points
+          CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ni=nbp_mpi, data_i_index=kindex_mpi-1) 
+          
+          ! Define longitudes and latitudes on local MPI domain
+          CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=longitude_mpi,latvalue_1d=latitude_mpi)
+          CALL xios_set_domain_attr("domain_landpoints",bounds_lon_1d=RESHAPE(bounds_lon_mpi,(/nvertex,ij_nb/),order=(/2,1/)))
+          CALL xios_set_domain_attr("domain_landpoints",bounds_lat_1d=RESHAPE(bounds_lat_mpi,(/nvertex,ij_nb/),order=(/2,1/)))
+          ! Define output grid as domain_landpoints_regular (grid specified in xml files)
+          CALL xios_set_domain_attr("domain_landpoints_out",domain_ref="domain_landpoints_regular")
+          CALL xios_set_fieldgroup_attr("remap_expr",expr="@this_ref")
+       END IF
+
+       !
+       !! 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("nlut",n_glo=nlut ,VALUE=(/(REAL(i,r_std),i=1,nlut)/))
+       CALL xios_set_axis_attr("ncarb",n_glo=ncarb ,VALUE=(/(REAL(i,r_std),i=1,ncarb)/))
+       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("ncsm", n_glo=nscm,VALUE=(/(REAL(i,r_std),i=1,nscm)/))
+       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("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("nsnow", n_glo=nsnow,VALUE=(/(REAL(i,r_std),i=1,nsnow)/))
+              
+       !
+       !! 5. Get the default value (missing value) used by XIOS. This value is set in field_def_orchidee.xml
+       !
+       CALL xios_get_fieldgroup_attr("field_definition", default_value=xios_default_val)
+       IF (printlev>=2) WRITE(numout,*) 'Default value read from XIOS, xios_default_val=',xios_default_val
+
+       !
+       !! 5. Deactivation of some fields if they are not calculated
+       !
+       IF ( OFF_LINE_MODE ) THEN
+          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.)
+       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
+
+       ! Set record_offset for enable start in the middle of the year.
+       ! julian_diff is the day of the year where the current run start
+       IF (printlev>=3) WRITE(numout,*) 'In xios_orchidee_init, julian_diff, INT(julian_diff) =', &
+            julian_diff, INT(julian_diff)
+
+       IF (ok_nudge_mc .AND. nudge_interpol_with_xios) THEN
+          ! Activate the input file with id="nudge_moistc" specified in file_def_orchidee.xml. 
+          ! The nudging file should be called nudge_moistc.nc (see name in the xml file) and is 
+          ! supposed to contain daily values for the full year for the variable moistc.
+          CALL xios_set_file_attr("nudge_moistc",enabled=.TRUE.)
+          ! Set record_offset to start read at correct day in the nudging file. 
+          CALL xios_set_file_attr("nudge_moistc",record_offset=INT(julian_diff))
+       ELSE
+          ! Deactivate input file for nudging of soil moisture
+          CALL xios_set_file_attr("nudge_moistc",enabled=.FALSE.)
+          ! Deactivate variables related to soil moisture nudgnig
+          CALL xios_set_field_attr("mask_moistc_interp",enabled=.FALSE.)
+          CALL xios_set_field_attr("moistc_interp",enabled=.FALSE.)
+
+          ! Deactivate output variables related to soil moisture nudging
+          CALL xios_set_field_attr("mc_read_current",enabled=.FALSE.)
+          CALL xios_set_field_attr("mc_read_prev",enabled=.FALSE.)
+          CALL xios_set_field_attr("mc_read_next",enabled=.FALSE.)
+          CALL xios_set_field_attr("mask_mc_interp_out",enabled=.FALSE.)
+       END IF
+       IF (.NOT. ok_nudge_mc ) CALL xios_set_field_attr("nudgincsm",enabled=.FALSE.)
+
+       IF (ok_nudge_snow .AND. nudge_interpol_with_xios) THEN
+          ! Activate the input file with id="nudge_snow" specified in file_def_orchidee.xml. 
+          ! The nudging file should be called nudge_snow.nc (see name in the xml file) and is 
+          ! supposed to contain daily values for the full year for the variables snowdz, snowtemp and snowrho.
+          CALL xios_set_file_attr("nudge_snow",enabled=.TRUE.)
+          ! Set record_offset to start read at correct day in the nudging file. 
+          CALL xios_set_file_attr("nudge_snow",record_offset=INT(julian_diff))
+       ELSE
+          ! Deactivate input file for nudging of snow variables
+          CALL xios_set_file_attr("nudge_snow",enabled=.FALSE.)
+
+          ! Deactivate input variables related to snow nudging
+          CALL xios_set_field_attr("mask_snow_interp",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowdz_interp",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowrho_interp",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowtemp_interp",enabled=.FALSE.)
+
+          ! Deactivate output variables related to snow nudging
+          CALL xios_set_field_attr("snowdz_read_current",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowdz_read_prev",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowdz_read_next",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowrho_read_current",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowrho_read_prev",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowrho_read_next",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowtemp_read_current",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowtemp_read_prev",enabled=.FALSE.)
+          CALL xios_set_field_attr("snowtemp_read_next",enabled=.FALSE.)
+          CALL xios_set_field_attr("mask_snow_interp_out",enabled=.FALSE.)
+       END IF
+       IF (.NOT. ok_nudge_snow) CALL xios_set_field_attr("nudgincswe",enabled=.FALSE.)
+
+       IF (impaze) THEN
+          CALL xios_set_field_attr("soilalb_vis",enabled=.FALSE.)
+          CALL xios_set_field_attr("soilalb_nir",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegalb_vis",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegalb_nir",enabled=.FALSE.)
+       END IF
+
+       IF (.NOT. do_wood_harvest) THEN
+          CALL xios_set_field_attr("PROD10_HARVEST",enabled=.FALSE.)
+          CALL xios_set_field_attr("FLUX10_HARVEST",enabled=.FALSE.)
+          CALL xios_set_field_attr("PROD100_HARVEST",enabled=.FALSE.)
+          CALL xios_set_field_attr("FLUX100_HARVEST",enabled=.FALSE.)
+          CALL xios_set_field_attr("CONVFLUX_HARVEST",enabled=.FALSE.)
+          CALL xios_set_field_attr("CFLUX_PROD10_HARVEST",enabled=.FALSE.)
+          CALL xios_set_field_attr("CFLUX_PROD100_HARVEST",enabled=.FALSE.)
+          CALL xios_set_field_attr("WOOD_HARVEST",enabled=.FALSE.)
+          CALL xios_set_field_attr("WOOD_HARVEST_PFT",enabled=.FALSE.)
+       END IF
+
+
+#endif
+    END IF
+
+    IF (xios_orchidee_ok) THEN
+       ! Send variables to all OMP thredds
+       CALL bcast(xios_default_val)
+       CALL bcast(almaoutput)
+    END IF
+
+    IF (printlev>=3) WRITE(numout,*) 'End xios_orchidee_init'
+  END SUBROUTINE xios_orchidee_init
+
+
+  SUBROUTINE xios_orchidee_close_definition
+
+    IF (printlev >=4) WRITE(numout,*) 'Start xios_orchidee_close_definition'
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+
+       !
+       !! 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.
+          IF (printlev >=3) WRITE(numout,*) 'The flag almaoutput has been activated in xios_orchidee_init'
+       END IF
+#endif
+    END IF
+
+    IF (xios_orchidee_ok) THEN
+       ! Send variables to all OMP thredds
+       CALL bcast(xios_default_val)
+       CALL bcast(almaoutput)
+    END IF
+    IF (printlev >=4) WRITE(numout,*) 'End xios_orchidee_close_definition'
+  END SUBROUTINE xios_orchidee_close_definition
+  
+  
+  
+  !! ==============================================================================================================================
+  !! 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
+ 
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_recv_field_r2d
+  !!
+  !>\BRIEF          Subroutine for receiving 1D (kjpindex) fields to XIOS. 
+  !!
+  !! DESCRIPTION  :\n 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_recv_field_r1d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)              :: field_id
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:), INTENT(OUT)    :: 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_recv_field_r1d, field_id=',field_id
+
+       ! All master threads receive the field from XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_recv_field(field_id,field_mpi)
+          IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r1d, field_id=',field_id
+#endif
+       END IF
+
+       ! Scatter the mpi domains on local omp domains
+       CALL scatter_omp(field_mpi, field)
+
+    END IF
+  END SUBROUTINE xios_orchidee_recv_field_r1d
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_recv_field_r2d
+  !!
+  !>\BRIEF          Subroutine for receiving 2D(kjpindex and 1 vertical axe) fields to XIOS. 
+  !!
+  !! DESCRIPTION  :\n 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_recv_field_r2d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)              :: field_id
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:,:), INTENT(OUT)  :: 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_recv_field_r2d, field_id=',field_id
+
+       ! All master threads recieve the field from XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_recv_field(field_id,field_mpi)
+          IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r2d, field_id=',field_id
+#endif
+       END IF
+
+       ! Scatter the mpi domains on local omp domains
+       CALL scatter_omp(field_mpi, field)
+
+    END IF
+  END SUBROUTINE xios_orchidee_recv_field_r2d
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_recv_field_r3d
+  !!
+  !>\BRIEF          Subroutine for receiving 3D(kjpindex and 2 vertical axes) fields to XIOS. 
+  !!
+  !! DESCRIPTION  :\n 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_recv_field_r3d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)              :: field_id
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:,:,:), INTENT(OUT) :: 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_recv_field_r3d, field_id=',field_id
+
+       ! All master threads receive the field from XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_recv_field(field_id,field_mpi)
+          IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r3d, field_id=',field_id
+#endif
+       END IF
+
+       ! Scatter the mpi domains on local omp domains
+       CALL scatter_omp(field_mpi, field)
+
+    END IF
+  END SUBROUTINE xios_orchidee_recv_field_r3d
+
+
+
+  SUBROUTINE xios_orchidee_set_file_attr(attr, name, enabled)
+    CHARACTER(LEN=*), INTENT(IN)            :: attr     ! Name of the attribut
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: name     ! New name
+    LOGICAL, INTENT(IN), OPTIONAL             :: enabled ! Flag
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+
+#ifdef XIOS
+       IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
+         CALL xios_set_file_attr(attr, name=name, enabled=enabled)
+       ELSE IF (PRESENT(name)) THEN
+         CALL xios_set_file_attr(attr, name=name)
+       ELSE IF (PRESENT(enabled)) THEN
+         CALL xios_set_file_attr(attr, enabled=enabled)
+       ELSE
+         CALL xios_set_file_attr(attr)
+       END IF
+#endif
+
+    END IF
+
+  END SUBROUTINE xios_orchidee_set_file_attr
+  
+  SUBROUTINE xios_orchidee_set_field_attr(attr,name, enabled)
+    CHARACTER(LEN=*), INTENT(IN)            :: attr     ! Name of the attribut
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: name     ! New name
+    LOGICAL, INTENT(IN), OPTIONAL             :: enabled ! Flag
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+
+#ifdef XIOS
+       IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
+         CALL xios_set_field_attr(attr, name=name, enabled=enabled)
+       ELSE IF (PRESENT(name)) THEN
+         CALL xios_set_field_attr(attr, name=name)
+       ELSE IF (PRESENT(enabled)) THEN
+         CALL xios_set_field_attr(attr, enabled=enabled)
+       ELSE
+         CALL xios_set_field_attr(attr)
+       END IF
+#endif
+
+    END IF
+
+
+  END SUBROUTINE xios_orchidee_set_field_attr
+  
+  SUBROUTINE xios_orchidee_set_fieldgroup_attr(attr,name, enabled)
+    CHARACTER(LEN=*), INTENT(IN)            :: attr     ! Name of the attribut
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: name     ! New name
+    LOGICAL, INTENT(IN), OPTIONAL             :: enabled ! Flag
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+
+#ifdef XIOS
+       IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
+         CALL xios_set_fieldgroup_attr(attr, name=name, enabled=enabled)
+       ELSE IF (PRESENT(name)) THEN
+         CALL xios_set_fieldgroup_attr(attr, name=name)
+       ELSE IF (PRESENT(enabled)) THEN
+         CALL xios_set_fieldgroup_attr(attr, enabled=enabled)
+       ELSE
+         CALL xios_set_fieldgroup_attr(attr)
+       END IF
+#endif
+
+    END IF
+
+
+  END SUBROUTINE xios_orchidee_set_fieldgroup_attr
+  
+  FUNCTION xios_orchidee_setvar(varname,varvalue) RESULT (out)
+    CHARACTER(LEN=*), INTENT(IN) :: varname  ! Name of the variable
+    REAL, INTENT(IN)               :: varvalue ! Value of the variable
+    LOGICAL :: out
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+      out=xios_setvar(varname, varvalue)
+#endif
+    END IF
+
+  END FUNCTION xios_orchidee_setvar
+
+END MODULE xios_orchidee
+
Index: /branches/publications/ORCHIDEE-AFP/src_parameters/AA_make
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/AA_make	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/AA_make	(revision 8430)
@@ -0,0 +1,89 @@
+#-
+#- $Id$
+#-
+IOIPSL_LIB = $(LIBDIR)/libioipsl.a
+SXIOIPSL_LIB = $(IOIPSL_LIB)
+#-Q- sxnec SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- sx6nec SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- eshpux SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- sx8brodie SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+MODS1 = constantes.f90 \
+	constantes_var.f90   \
+	constantes_soil.f90   \
+	constantes_soil_var.f90   \
+	constantes_mtc.f90   \
+	control.f90        \
+	pft_parameters.f90 \
+	pft_parameters_var.f90 
+#
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libioipsl
+	$(M_K) libparallel
+	$(M_K) m_all
+	@echo parameter is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+
+libioipsl:
+	(cd ../../IOIPSL/src; $(M_K) -f Makefile)
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+config:
+	$(BINDIR)/Fparser -name PARAMETERS  $(MODS1)
+	echo 'Configuration of PARAMETERS done'
+ 
+clean:
+	$(RM) $(MODEL_LIB)
+ 
+$(MODEL_LIB)(pft_parameters.o): \
+  $(MODEL_LIB)(pft_parameters_var.o) \
+  $(MODEL_LIB)(constantes_mtc.o)
+$(MODEL_LIB)(constantes_soil.o): \
+  $(MODEL_LIB)(constantes_soil_var.o) \
+  $(MODEL_LIB)(constantes.o)
+$(MODEL_LIB)(control.o): \
+  $(MODEL_LIB)(constantes_soil.o) \
+  $(MODEL_LIB)(constantes_var.o)  \
+  $(MODEL_LIB)(pft_parameters.o)
+
+$(MODEL_LIB)(constantes.o): \
+  $(MODEL_LIB)(constantes_var.o) \
+  $(MODEL_LIB)(constantes_soil_var.o) \
+  $(PARALLEL_LIB) \
+  $(IOIPSL_LIB)
+
Index: /branches/publications/ORCHIDEE-AFP/src_parameters/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/AA_make.ldef	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/AA_make.ldef	(revision 8430)
@@ -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-AFP/src_parameters/constantes.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/constantes.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/constantes.f90	(revision 8430)
@@ -0,0 +1,2341 @@
+! =================================================================================================================================
+! MODULE       : constantes
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        "constantes" module contains subroutines to initialize most of the exernalized parameters. This module
+!!              also make a use to the module constantes_var where the parameters are declared.
+!!
+!!\n DESCRIPTION: This module contains subroutines to initialize most of the exernalized parameters. This module
+!!                also make a use to the module constantes_var where the parameters are declared.\n
+!!                This module can be used to acces the subroutines and the constantes. The constantes declarations
+!!                can also be used seperatly with "USE constantes_var".
+!!
+!! RECENT CHANGE(S): Didier Solyga : This module contains now all the externalized parameters of ORCHIDEE 
+!!                   listed by modules which are not pft-dependent  
+!!                   Josefine Ghattas 2013 : The declaration part has been extracted and moved to module constates_var
+!!
+!! REFERENCE(S)	: 
+!! - Louis, Jean-Francois (1979), A parametric model of vertical eddy fluxes in the atmosphere. 
+!! Boundary Layer Meteorology, 187-202.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes
+
+  USE constantes_var
+  USE defprec
+  USE ioipsl_para, ONLY : getin_p, ipslerr_p
+  USE mod_orchidee_para_var, ONLY : numout
+  USE time, ONLY : one_day, dt_sechiba
+
+  IMPLICIT NONE
+  
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : activate_sub_models
+!!
+!>\BRIEF         This subroutine reads the flags in the configuration file to
+!! activate some sub-models like routing, irrigation, fire, herbivory, ...  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE activate_sub_models()
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables
+
+    !_ ================================================================================================================================
+
+    IF (ok_stomate) THEN
+
+       !Config Key   = HERBIVORES
+       !Config Desc  = herbivores allowed?
+       !Config If    = OK_STOMATE 
+       !Config Def   = n
+       !Config Help  = With this variable, you can determine
+       !Config         if herbivores are activated
+       !Config Units = [FLAG]
+       CALL getin_p('HERBIVORES', ok_herbivores)
+       !
+       !Config Key   = TREAT_EXPANSION
+       !Config Desc  = treat expansion of PFTs across a grid cell?
+       !Config If    = OK_STOMATE 
+       !Config Def   = n
+       !Config Help  = With this variable, you can determine
+       !Config         whether we treat expansion of PFTs across a
+       !Config         grid cell.
+       !Config Units = [FLAG]
+       CALL getin_p('TREAT_EXPANSION', treat_expansion)
+
+       !Config Key   = LPJ_GAP_CONST_MORT
+       !Config Desc  = Constant mortality
+       !Config If    = OK_STOMATE AND NOT OK_DGVM
+       !Config Def   = y/n depending on OK_DGVM
+       !Config Help  = set to TRUE if constant mortality is to be activated
+       !Config         
+       !Config Units = [FLAG]
+
+       ! Set Default value different if DGVM is activated.
+       IF ( ok_dgvm ) THEN
+          lpj_gap_const_mort=.FALSE.
+       ELSE
+          lpj_gap_const_mort=.TRUE.
+       END IF
+       CALL getin_p('LPJ_GAP_CONST_MORT', lpj_gap_const_mort)
+
+       IF (ok_dgvm .AND. lpj_gap_const_mort) THEN
+          CALL ipslerr_p(1,"activate_sub_models","Both OK_DGVM and LPJ_GAP_CONST_MORT are activated.",&
+               "This combination is possible but unusual","The simulation will continue with these flags activated." )
+       ELSEIF (.NOT. ok_dgvm  .AND. .NOT. lpj_gap_const_mort) THEN
+           CALL ipslerr_p(3,"activate_sub_models", &
+                "The combination of OK_DGVM=false and LPJ_GAP_CONST_MORT=false is not operational in this version", &
+                "Some parts of the code should first be revised.","" )
+       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   = y
+       !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)
+
+    ENDIF
+
+    !
+    ! Check consistency (see later)
+    !
+!!$        IF(.NOT.(ok_routing) .AND. (doirrigation .OR. dofloodplains)) THEN
+!!$           CALL ipslerr_p(2,'activate_sub_models', &
+!!$               &     'Problem :you tried to activate the irrigation and floodplains without activating the routing',&
+!!$               &     'Are you sure ?', &
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+
+!!$        IF(.NOT.(ok_stomate) .AND. (ok_herbivores .OR. treat_expansion .OR. lpj_gap_const_mort &
+!!$            & .OR. harvest_agri .OR. disable_fire)) THEN
+!!$          CALL ipslerr_p(2,'activate_sub_models', &
+!!$               &     'Problem : try to activate the following options : herbivory, treat_expansion, fire,',&
+!!$               &     'harvest_agri and constant mortality without stomate activated.',&
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+
+
+  END SUBROUTINE activate_sub_models
+
+!! ================================================================================================================================
+!! SUBROUTINE   : veget_config
+!!
+!>\BRIEF         This subroutine reads the flags controlling the configuration for
+!! the vegetation : impose_veg, veget_mpa, lai_map, etc...       
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE veget_config
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables  
+
+    !_ ================================================================================================================================
+
+    !Config Key   = AGRICULTURE
+    !Config Desc  = agriculture allowed?
+    !Config If    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = y
+    !Config Help  = With this variable, you can determine
+    !Config         whether agriculture is allowed
+    !Config Units = [FLAG]
+    CALL getin_p('AGRICULTURE', agriculture)
+    !
+    !Config Key   = IMPOSE_VEG
+    !Config Desc  = Should the vegetation be prescribed ?
+    !Config If    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = n
+    !Config Help  = This flag allows the user to impose a vegetation distribution
+    !Config         and its characteristics. It is espacially interesting for 0D
+    !Config         simulations. On the globe it does not make too much sense as
+    !Config         it imposes the same vegetation everywhere
+    !Config Units = [FLAG]
+    CALL getin_p('IMPOSE_VEG', impveg)
+
+    IF (impveg) THEN
+       !Config Key   = IMPOSE_SOILT
+       !Config Desc  = Should the soil type be prescribed ?
+       !Config Def   = n
+       !Config If    = IMPOSE_VEG
+       !Config Help  = This flag allows the user to impose a soil type distribution.
+       !Config         It is espacially interesting for 0D
+       !Config         simulations. On the globe it does not make too much sense as
+       !Config         it imposes the same soil everywhere
+       !Config Units = [FLAG]
+       CALL getin_p('IMPOSE_SOILT', impsoilt)     
+    ENDIF
+
+    !Config Key   = LAI_MAP
+    !Config Desc  = Read the LAI map
+    !Config If    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = n
+    !Config Help  = It is possible to read a 12 month LAI map which will
+    !Config         then be interpolated to daily values as needed.
+    !Config Units = [FLAG]
+    CALL getin_p('LAI_MAP',read_lai)
+
+    !Config Key   = VEGET_REINIT
+    !Config Desc  = Reset veget_year counter (obsolet)
+    !Config If    = VEGET_UPDATE > 0Y
+    !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   = VEGETMAP_RESET
+    !Config Desc  = Flag to change vegetation map without activating LAND USE change for carbon fluxes and reset carbon related variables to zero
+    !Config If    = 
+    !Config Def   = n
+    !Config Help  = Use this option to change vegetation map while keeping VEGET_UPDATE=0Y
+    !Config Units = [FLAG] 
+    CALL getin_p('VEGETMAP_RESET', vegetmap_reset)
+
+
+    !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)
+    
+
+!!$        ! DS : Add warning in case of a wrong configuration (need to be discussed)
+!!$        ! 4. 
+!!$        IF ( .NOT.(impveg) .AND. impsoilt) THEN
+!!$           CALL ipslerr_p(2,'veget_config', &
+!!$               &     'Problem : try to activate impose_soilt without activating impose_veg.',&
+!!$               &     'Are you sure ?', &
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+!!$
+
+  END SUBROUTINE veget_config
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : veget_config
+!!
+!>\BRIEF         This subroutine reads in the configuration file the imposed values of the parameters for all SECHIBA modules.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_sechiba_parameters
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables
+    REAL(r_std) :: nudge_tau_mc     !! Temporary variable read from run.def
+    REAL(r_std) :: nudge_tau_snow   !! Temporary variable read from run.def
+
+    !_ ================================================================================================================================
+
+    ! 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)
+
+    
+    !Config Key   = OK_NUDGE_MC
+    !Config Desc  = Activate nudging of soil moisture
+    !Config Def   = n
+    !Config If    = 
+    !Config Help  = 
+    !Config Units = [FLAG]
+    ok_nudge_mc = .FALSE.
+    CALL getin_p('OK_NUDGE_MC', ok_nudge_mc)
+
+    !Config Key   = NUDGE_TAU_MC
+    !Config Desc  = Relaxation time for nudging of soil moisture expressed in fraction of the day
+    !Config Def   = 1
+    !Config If    = OK_NUDGE_MC
+    !Config Help  = 
+    !Config Units = [-]
+    nudge_tau_mc = 1.0
+    CALL getin_p('NUDGE_TAU_MC', nudge_tau_mc)
+    IF (nudge_tau_mc < dt_sechiba/one_day) CALL ipslerr_p(3, 'hydrol_initialize', &
+         'NUDGE_TAU_MC is smaller than the time step in sechiba which is not allowed.', &
+         'Set NUDGE_TAU_MC higher or equal to dt_sechiba/one_day','')
+    ! Calculate alpha to be used in hydrol
+    alpha_nudge_mc = dt_sechiba/(one_day*nudge_tau_mc)
+    IF (printlev>=2) WRITE(numout, *) 'ok_nudge_mc, nudge_tau_mc, alpha_nudge_mc =', &
+         ok_nudge_mc, nudge_tau_mc, alpha_nudge_mc
+
+
+    !Config Key   = OK_NUDGE_SNOW
+    !Config Desc  = Activate nudging of snow variables
+    !Config Def   = n
+    !Config If    = 
+    !Config Help  = 
+    !Config Units = [FLAG]
+    ok_nudge_snow = .FALSE.
+    CALL getin_p('OK_NUDGE_SNOW', ok_nudge_snow)
+
+    !Config Key   = NUDGE_TAU_SNOW
+    !Config Desc  = Relaxation time for nudging of snow variables
+    !Config Def   = 1
+    !Config If    = OK_NUDGE_SNOW
+    !Config Help  = 
+    !Config Units = [-]
+    nudge_tau_snow = 1.0
+    CALL getin_p('NUDGE_TAU_SNOW', nudge_tau_snow)
+    IF (nudge_tau_snow < dt_sechiba/one_day) CALL ipslerr_p(3, 'hydrol_initialize', &
+         'NUDGE_TAU_SNOW is smaller than the time step in sechiba which is not allowed.', &
+         'Set NUDGE_TAU_SNOW higher or equal to dt_sechiba/one_day','')
+    ! Calculate alpha to be used in hydrol
+    alpha_nudge_snow = dt_sechiba/(one_day*nudge_tau_snow)
+    IF (printlev>=2) WRITE(numout, *) 'ok_nudge_snow, nudge_tau_snow, alpha_nudge_snow =', &
+         ok_nudge_snow, nudge_tau_snow, alpha_nudge_snow
+
+
+    !Config Key   = NUDGE_INTERPOL_WITH_XIOS
+    !Config Desc  = Activate reading and interpolation with XIOS for nudging fields
+    !Config Def   = n
+    !Config If    = OK_NUDGE_MC or OK_NUDGE_SNOW
+    !Config Help  = 
+    !Config Units = [FLAG]
+    nudge_interpol_with_xios = .FALSE.
+    CALL getin_p('NUDGE_INTERPOL_WITH_XIOS', nudge_interpol_with_xios)
+
+    !-
+    ! 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   = y
+    !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 LE emission
+       !Config         of the surface in a 0-dim version. Values range between 
+       !Config         0.97 and 1.. The GCM uses 0.98.
+       !Config Units = [-] 
+       CALL getin_p('CONDVEG_EMIS', emis_scal)
+    ENDIF
+
+    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)
+    !
+
+    !
+    !-
+    ! 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   = y
+    !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   = 380.
+    !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 sand
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 0.4 
+    !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.4 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('SILTFRACTION_DEFAULT',siltfraction_default)
+
+
+    IF ( ABS(clayfraction_default+sandfraction_default+siltfraction_default-1) > min_sechiba) THEN
+       WRITE(numout,*) 'Incoherence found. clayfraction_default=', clayfraction_default, ' sandfraction_default=',&
+            sandfraction_default,' siltfraction_default=',siltfraction_default
+       CALL ipslerr_p(3,"config_sechiba_parameters",&
+            "Inconsistecy between CLAYFRACTION_DEFAULT, SANDFRACTION_DEFAULT and SILTFRACTION_DEFAULT set in run.def",&
+            "The sum should be equal 1 but this is not the case.","Modify run.def and restart the model")
+    END IF
+    !
+    !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)
+    !
+
+  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
+
+    !! 0.4 Local variables
+
+    !_ ================================================================================================================================
+
+    !
+    !Config Key   = LAI_LEVEL_DEPTH
+    !Config Desc  = 
+    !Config If    = 
+    !Config Def   = 0.15
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('LAI_LEVEL_DEPTH',lai_level_depth)
+    !
+    !Config Key   = Oi
+    !Config Desc  = Intercellular oxygen partial pressure
+    !Config If    = 
+    !Config Def   = 210000.
+    !Config Help  = See Legend of Figure 6 of Yin et al. (2009)
+    !Config Units = [ubar]  
+    CALL getin_p('Oi',Oi)
+
+
+  END SUBROUTINE config_co2_parameters
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_stomate_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when stomate is activated (ie : when OK_STOMATE is set to true).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_stomate_parameters
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables   
+
+
+    !_ ================================================================================================================================
+
+    !-
+    ! constraints_parameters
+    !-
+    !
+    !Config Key   = TOO_LONG 
+    !Config Desc  = longest sustainable time without regeneration (vernalization)
+    !Config If    = OK_STOMATE
+    !Config Def   = 5.
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TOO_LONG',too_long)
+
+    !-
+    ! fire parameters
+    !-
+    !
+    !Config Key   = TAU_FIRE 
+    !Config Desc  = Time scale for memory of the fire index (days). Validated for one year in the DGVM. 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 30.
+    !Config Help  = 
+    !Config Units = [days]    
+    CALL getin_p('TAU_FIRE',tau_fire)
+    !
+    !Config Key   = LITTER_CRIT
+    !Config Desc  = Critical litter quantity for fire
+    !Config If    = OK_STOMATE 
+    !Config Def   = 200.
+    !Config Help  = 
+    !Config Units = [gC/m^2]  
+    CALL getin_p('LITTER_CRIT',litter_crit)
+    !
+    !Config Key   = FIRE_RESIST_STRUCT
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('FIRE_RESIST_STRUCT',fire_resist_struct)
+    !
+    !
+    !Config Key   = CO2FRAC
+    !Config Desc  = What fraction of a burned plant compartment goes into the atmosphere
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.95, 0.95, 0., 0.3, 0., 0., 0.95, 0.95
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('CO2FRAC',co2frac)
+    !
+    !Config Key   = BCFRAC_COEFF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3, 1.3, 88.2 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('BCFRAC_COEFF',bcfrac_coeff)
+    !
+    !Config Key   = FIREFRAC_COEFF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.45, 0.8, 0.6, 0.13
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FIREFRAC_COEFF',firefrac_coeff)
+
+    !Config Key   = REF_GREFF
+    !Config Desc  = Asymptotic maximum mortality rate
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.035
+    !Config Help  = Set asymptotic maximum mortality rate from Sitch 2003
+    !Config         (they use 0.01) (year^{-1})
+    !Config Units = [1/year]  
+    CALL getin_p('REF_GREFF',ref_greff)
+    !-
+    ! allocation parameters
+    !-
+    !
+    !Config Key   = OK_MINRES
+    !Config Desc  = Do we try to reach a minimum reservoir even if we are severely stressed?
+    !Config If    = OK_STOMATE 
+    !Config Def   = y
+    !Config Help  = 
+    !Config Units = [FLAG]
+    CALL getin_p('OK_MINRES',ok_minres)
+    !
+    !Config Key   = RESERVE_TIME_TREE 
+    !Config Desc  = maximum time during which reserve is used (trees) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 30.
+    !Config Help  = 
+    !Config Units = [days]    
+    CALL getin_p('RESERVE_TIME_TREE',reserve_time_tree)
+    !
+    !Config Key   = RESERVE_TIME_GRASS 
+    !Config Desc  = maximum time during which reserve is used (grasses) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('RESERVE_TIME_GRASS',reserve_time_grass)
+    !
+    !Config Key   = F_FRUIT
+    !Config Desc  = Standard fruit allocation
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.1 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('F_FRUIT',f_fruit)
+    !
+    !Config Key   = ALLOC_SAP_ABOVE_GRASS 
+    !Config Desc  = fraction of sapwood allocation above ground 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.0 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('ALLOC_SAP_ABOVE_GRASS',alloc_sap_above_grass)
+    !
+    !Config Key   = MIN_LTOLSR 
+    !Config Desc  = extrema of leaf allocation fraction 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.2
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MIN_LTOLSR',min_LtoLSR)
+    !
+    !Config Key   = MAX_LTOLSR
+    !Config Desc  = extrema of leaf allocation fraction
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MAX_LTOLSR',max_LtoLSR)
+    !
+    !Config Key   = Z_NITROGEN
+    !Config Desc  = scaling depth for nitrogen limitation 
+    !Config If    = OK_STOMATE
+    !Config Def   = 0.2 
+    !Config Help  =
+    !Config Units = [m]  
+    CALL getin_p('Z_NITROGEN',z_nitrogen)
+    !
+    !Config Key   = NLIM_TREF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 25. 
+    !Config Help  = 
+    !Config Units = [C]  
+    CALL getin_p('NLIM_TREF',Nlim_tref) 
+
+    !-
+    ! data parameters
+    !-
+    !
+    !Config Key   = PIPE_TUNE1
+    !Config Desc  = crown area = pipe_tune1. stem diameter**(1.6) (Reinicke's theory)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 100.0
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('PIPE_TUNE1',pipe_tune1)
+    !
+    !Config Key   = PIPE_TUNE2 
+    !Config Desc  = height=pipe_tune2 * diameter**pipe_tune3
+    !Config If    = OK_STOMATE 
+    !Config Def   = 40.0 
+    !Config Help  = 
+    !Config Units = [-]      
+    CALL getin_p('PIPE_TUNE2',pipe_tune2) 
+    !
+    !Config Key   = PIPE_TUNE3
+    !Config Desc  = height=pipe_tune2 * diameter**pipe_tune3
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('PIPE_TUNE3',pipe_tune3)
+    !
+    !Config Key   = PIPE_TUNE4
+    !Config Desc  = needed for stem diameter
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('PIPE_TUNE4',pipe_tune4)
+    !
+    !Config Key   = PIPE_DENSITY 
+    !Config Desc  = Density
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2.e5 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('PIPE_DENSITY',pipe_density)
+    !
+    !Config Key   = PIPE_K1 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 8.e3 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('PIPE_K1',pipe_k1)
+    !
+    !Config Key   = PIPE_TUNE_EXP_COEFF 
+    !Config Desc  = pipe tune exponential coeff 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.6 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('PIPE_TUNE_EXP_COEFF',pipe_tune_exp_coeff)
+    !
+    !
+    !Config Key   = PRECIP_CRIT 
+    !Config Desc  = minimum precip
+    !Config If    = OK_STOMATE 
+    !Config Def   = 100.
+    !Config Help  = 
+    !Config Units = [mm/year]  
+    CALL getin_p('PRECIP_CRIT',precip_crit)
+    !
+    !Config Key   = GDD_CRIT_ESTAB
+    !Config Desc  = minimum gdd for establishment of saplings
+    !Config If    = OK_STOMATE 
+    !Config Def   = 150. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('GDD_CRIT_ESTAB',gdd_crit_estab)
+    !
+    !Config Key   = FPC_CRIT
+    !Config Desc  = critical fpc, needed for light competition and establishment
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.95
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('FPC_CRIT',fpc_crit)
+    !
+    !Config Key   = ALPHA_GRASS
+    !Config Desc  = sapling characteristics : alpha's
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('ALPHA_GRASS',alpha_grass)
+    !
+    !Config Key   = ALPHA_TREE
+    !Config Desc  = sapling characteristics : alpha's 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('ALPHA_TREE',alpha_tree)
+    !-
+    !
+    !Config Key   = MASS_RATIO_HEART_SAP
+    !Config Desc  = mass ratio (heartwood+sapwood)/sapwood
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3.
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MASS_RATIO_HEART_SAP',mass_ratio_heart_sap)
+    !
+    !Config Key   = TAU_HUM_MONTH
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]  
+    CALL getin_p('TAU_HUM_MONTH',tau_hum_month)
+    !
+    !Config Key   = TAU_HUM_WEEK
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 7.
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_HUM_WEEK',tau_hum_week)
+    !
+    !Config Key   = TAU_T2M_MONTH
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20.
+    !Config Help  = 
+    !Config Units = [days]     
+    CALL getin_p('TAU_T2M_MONTH',tau_t2m_month)
+    !
+    !Config Key   = TAU_T2M_WEEK
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 7.
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_T2M_WEEK',tau_t2m_week)
+    !
+    !Config Key   = TAU_TSOIL_MONTH 
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]     
+    CALL getin_p('TAU_TSOIL_MONTH',tau_tsoil_month)
+    !
+    !Config Key   = TAU_SOILHUM_MONTH
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_SOILHUM_MONTH',tau_soilhum_month)
+    !
+    !Config Key   = TAU_GPP_WEEK 
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 7. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_GPP_WEEK',tau_gpp_week)
+    !
+    !Config Key   = TAU_GDD
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 40. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_GDD',tau_gdd)
+    !
+    !Config Key   = TAU_NGD
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 50.
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('TAU_NGD',tau_ngd)
+    !
+    !Config Key   = COEFF_TAU_LONGTERM
+    !Config Desc  = time scales for phenology and other processes
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3. 
+    !Config Help  = 
+    !Config Units = [days]   
+    CALL getin_p('COEFF_TAU_LONGTERM',coeff_tau_longterm)
+    !-
+    !
+    !Config Key   = BM_SAPL_CARBRES 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5. 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('BM_SAPL_CARBRES',bm_sapl_carbres)
+    !
+    !Config Key   = BM_SAPL_SAPABOVE
+    !Config Desc  = 
+    !Config If    = OK_STOMATE
+    !Config Def   = 0.5 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('BM_SAPL_SAPABOVE',bm_sapl_sapabove)
+    !
+    !Config Key   = BM_SAPL_HEARTABOVE 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2.
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('BM_SAPL_HEARTABOVE',bm_sapl_heartabove)
+    !
+    !Config Key   = BM_SAPL_HEARTBELOW 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2. 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('BM_SAPL_HEARTBELOW',bm_sapl_heartbelow)
+    !
+    !Config Key   = INIT_SAPL_MASS_LEAF_NAT
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.1 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_LEAF_NAT',init_sapl_mass_leaf_nat)
+    !
+    !Config Key   = INIT_SAPL_MASS_LEAF_AGRI
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1. 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_LEAF_AGRI',init_sapl_mass_leaf_agri)
+    !
+    !Config Key   = INIT_SAPL_MASS_CARBRES
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5. 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_CARBRES',init_sapl_mass_carbres)
+    !
+    !Config Key   = INIT_SAPL_MASS_ROOT
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.1 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('INIT_SAPL_MASS_ROOT',init_sapl_mass_root)
+    !
+    !Config Key   = INIT_SAPL_MASS_FRUIT
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3 
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('INIT_SAPL_MASS_FRUIT',init_sapl_mass_fruit)
+    !
+    !Config Key   = CN_SAPL_INIT 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('CN_SAPL_INIT',cn_sapl_init)
+    !
+    !Config Key   = MIGRATE_TREE 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 10000.
+    !Config Help  = 
+    !Config Units = [m/year]   
+    CALL getin_p('MIGRATE_TREE',migrate_tree)
+    !
+    !Config Key   = MIGRATE_GRASS
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 10000.
+    !Config Help  = 
+    !Config Units = [m/year]   
+    CALL getin_p('MIGRATE_GRASS',migrate_grass)
+    !
+    !Config Key   = LAI_INITMIN_TREE
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3
+    !Config Help  = 
+    !Config Units = [m^2/m^2]  
+    CALL getin_p('LAI_INITMIN_TREE',lai_initmin_tree)
+    !
+    !Config Key   = LAI_INITMIN_GRASS 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.1
+    !Config Help  = 
+    !Config Units = [m^2/m^2]    
+    CALL getin_p('LAI_INITMIN_GRASS',lai_initmin_grass)
+    !
+    !Config Key   = DIA_COEFF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 4., 0.5
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('DIA_COEFF',dia_coeff)
+    !
+    !Config Key   = MAXDIA_COEFF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 100., 0.01 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MAXDIA_COEFF',maxdia_coeff)
+    !
+    !Config Key   = BM_SAPL_LEAF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 4., 4., 0.8, 5. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('BM_SAPL_LEAF',bm_sapl_leaf)
+
+    !-
+    ! litter parameters
+    !-
+    !
+    !Config Key   = METABOLIC_REF_FRAC
+    !Config Desc  =
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.85  
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('METABOLIC_REF_FRAC',metabolic_ref_frac)
+    !
+    !Config Key   = Z_DECOMP
+    !Config Desc  = scaling depth for soil activity
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.2
+    !Config Help  = 
+    !Config Units = [m]   
+    CALL getin_p('Z_DECOMP',z_decomp)
+    !
+    !Config Key   = CN
+    !Config Desc  = C/N ratio
+    !Config If    = OK_STOMATE 
+    !Config Def   = 40., 40., 40., 40., 40., 40., 40., 40.
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('CN',CN)
+    !
+    !Config Key   = LC 
+    !Config Desc  = Lignine/C ratio of the different plant parts
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('LC',LC)
+    !
+    !Config Key   = FRAC_SOIL_STRUCT_AA
+    !Config Desc  = frac_soil(istructural,iactive,iabove)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.55
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('FRAC_SOIL_STRUCT_AA',frac_soil_struct_aa)
+    !
+    !Config Key   = FRAC_SOIL_STRUCT_A 
+    !Config Desc  = frac_soil(istructural,iactive,ibelow)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.45
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('FRAC_SOIL_STRUCT_AB',frac_soil_struct_ab)
+    !
+    !Config Key   = FRAC_SOIL_STRUCT_SA
+    !Config Desc  = frac_soil(istructural,islow,iabove)
+    !Config If    = OK_STOMATE
+    !Config Def   = 0.7  
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FRAC_SOIL_STRUCT_SA',frac_soil_struct_sa)
+    !
+    !Config Key   = FRAC_SOIL_STRUCT_SB
+    !Config Desc  = frac_soil(istructural,islow,ibelow) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.7  
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FRAC_SOIL_STRUCT_SB',frac_soil_struct_sb)
+    !
+    !Config Key   = FRAC_SOIL_METAB_AA 
+    !Config Desc  = frac_soil(imetabolic,iactive,iabove) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.45 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FRAC_SOIL_METAB_AA',frac_soil_metab_aa)
+    !
+    !Config Key   = FRAC_SOIL_METAB_AB 
+    !Config Desc  = frac_soil(imetabolic,iactive,ibelow)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.45  
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('FRAC_SOIL_METAB_AB',frac_soil_metab_ab)
+    !
+    !
+    !Config Key   = METABOLIC_LN_RATIO
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.018  
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('METABOLIC_LN_RATIO',metabolic_LN_ratio) 
+    !
+    !Config Key   = TAU_METABOLIC
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.066
+    !Config Help  = 
+    !Config Units = [days] 
+    CALL getin_p('TAU_METABOLIC',tau_metabolic)
+    !
+    !Config Key   = TAU_STRUCT 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.245 
+    !Config Help  = 
+    !Config Units = [days]
+    CALL getin_p('TAU_STRUCT',tau_struct)
+    !
+    !Config Key   = SOIL_Q10
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.69 (=ln2)
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('SOIL_Q10',soil_Q10)
+    !
+    !Config Key   = TSOIL_REF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 30. 
+    !Config Help  = 
+    !Config Units = [C]   
+    CALL getin_p('TSOIL_REF',tsoil_ref)
+    !
+    !Config Key   = LITTER_STRUCT_COEF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3. 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('LITTER_STRUCT_COEF',litter_struct_coef)
+    !
+    !Config Key   = MOIST_COEFF
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.1, 2.4, 0.29
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MOIST_COEFF',moist_coeff)
+    !
+    !Config Key   = MOISTCONT_MIN
+    !Config Desc  = minimum soil wetness to limit the heterotrophic respiration
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.25
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('MOISTCONT_MIN',moistcont_min)
+
+    !-
+    ! lpj parameters
+    !-
+    !
+    !Config Key   = FRAC_TURNOVER_DAILY 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.55
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('FRAC_TURNOVER_DAILY',frac_turnover_daily)   
+
+    !-
+    ! npp parameters
+    !-
+    !
+    !Config Key   = TAX_MAX
+    !Config Desc  = maximum fraction of allocatable biomass used for maintenance respiration
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.8
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('TAX_MAX',tax_max) 
+
+    !-
+    ! phenology parameters
+    !-
+    !Config Key   = MIN_GROWTHINIT_TIME 
+    !Config Desc  = minimum time since last beginning of a growing season
+    !Config If    = OK_STOMATE 
+    !Config Def   = 300. 
+    !Config Help  = 
+    !Config Units = [days]  
+    CALL getin_p('MIN_GROWTHINIT_TIME',min_growthinit_time)
+    !
+    !Config Key   = MOIAVAIL_ALWAYS_TREE
+    !Config Desc  = moisture availability above which moisture tendency doesn't matter 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.0 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MOIAVAIL_ALWAYS_TREE',moiavail_always_tree)
+    !
+    !Config Key   = MOIAVAIL_ALWAYS_GRASS 
+    !Config Desc  = moisture availability above which moisture tendency doesn't matter
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.6 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('MOIAVAIL_ALWAYS_GRASS',moiavail_always_grass)
+    !
+    !Config Key   = T_ALWAYS_ADD
+    !Config Desc  = monthly temp. above which temp. tendency doesn't matter 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 10.
+    !Config Help  = 
+    !Config Units = [C]    
+    CALL getin_p('T_ALWAYS_ADD',t_always_add)
+    !
+    !
+    !Config Key   = GDDNCD_REF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 603. 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('GDDNCD_REF',gddncd_ref)
+    !
+    !Config Key   = GDDNCD_CURVE
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.0091 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('GDDNCD_CURVE',gddncd_curve)
+    !
+    !Config Key   = GDDNCD_OFFSET
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 64. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('GDDNCD_OFFSET',gddncd_offset)
+    !-
+    ! prescribe parameters
+    !-
+    !
+    !Config Key   = BM_SAPL_RESCALE 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 40. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('BM_SAPL_RESCALE',bm_sapl_rescale)
+
+    !-
+    ! respiration parameters
+    !-
+    !
+    !Config Key   = MAINT_RESP_MIN_VMAX
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('MAINT_RESP_MIN_VMAX',maint_resp_min_vmax)  
+    !
+    !Config Key   = MAINT_RESP_COEFF 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.4 
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('MAINT_RESP_COEFF',maint_resp_coeff)
+
+    !-
+    ! soilcarbon parameters 
+    !-
+    !
+    !Config Key   = FRAC_CARB_AP
+    !Config Desc  = frac carb coefficients from active pool: depends on clay content
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.004
+    !Config Help  = fraction of the active pool going into the passive pool
+    !Config Units = [-]
+    CALL getin_p('FRAC_CARB_AP',frac_carb_ap)  
+    !
+    !Config Key   = FRAC_CARB_SA
+    !Config Desc  = frac_carb_coefficients from slow pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.42
+    !Config Help  = fraction of the slow pool going into the active pool
+    !Config Units = [-]
+    CALL getin_p('FRAC_CARB_SA',frac_carb_sa)
+    !
+    !Config Key   = FRAC_CARB_SP
+    !Config Desc  = frac_carb_coefficients from slow pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.03
+    !Config Help  = fraction of the slow pool going into the passive pool
+    !Config Units = [-] 
+    CALL getin_p('FRAC_CARB_SP',frac_carb_sp)
+    !
+    !Config Key   = FRAC_CARB_PA
+    !Config Desc  = frac_carb_coefficients from passive pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.45
+    !Config Help  = fraction of the passive pool going into the active pool
+    !Config Units = [-]
+    CALL getin_p('FRAC_CARB_PA',frac_carb_pa)
+    !
+    !Config Key   = FRAC_CARB_PS
+    !Config Desc  = frac_carb_coefficients from passive pool
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.0
+    !Config Help  = fraction of the passive pool going into the slow pool
+    !Config Units = [-]
+    CALL getin_p('FRAC_CARB_PS',frac_carb_ps)
+    !
+    !Config Key   = ACTIVE_TO_PASS_CLAY_FRAC
+    !Config Desc  = 
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.68  
+    !Config Help  =
+    !Config Units = [-] 
+    CALL getin_p('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac)
+    !
+    !Config Key   = CARBON_TAU_IACTIVE
+    !Config Desc  = residence times in carbon pools
+    !Config if    = OK_STOMATE 
+    !Config Def   = 0.149
+    !Config Help  =
+    !Config Units =  [days] 
+    CALL getin_p('CARBON_TAU_IACTIVE',carbon_tau_iactive)
+    !
+    !Config Key   = CARBON_TAU_ISLOW
+    !Config Desc  = residence times in carbon pools
+    !Config if    = OK_STOMATE 
+    !Config Def   = 7.0
+    !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   = 300.
+    !Config Help  = residence time in the passive pool
+    !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)
+
+    !-
+    ! 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)
+
+     ! liulyc 
+     !BELOW Wrong
+    ! CALL getin_p('lly_turn_sw_para1',turn_sw_para1)
+    ! CALL getin_p('lly_turn_sw_para2',turn_sw_para2)
+    ! CALL getin_p('lly_turn_sw_para3',turn_sw_para3)
+    ! CALL getin_p('lly_turn_sw_para4',turn_sw_para4)
+    ! CALL getin_p('lly_turn_sw_para5',turn_sw_para5)
+
+    ! CALL getin_p('lly_turn_fra_para1',turn_fra_para1)
+    ! CALL getin_p('lly_turn_fra_para2',turn_fra_para2)
+    ! CALL getin_p('lly_turn_fra_para3',turn_fra_para3)
+    ! CALL getin_p('lly_turn_fra_para4',turn_fra_para4)
+
+
+    CALL getin_p('TURN_SW_PARA1',turn_sw_para1)
+    CALL getin_p('TURN_SW_PARA2',turn_sw_para2)
+    CALL getin_p('TURN_SW_PARA3',turn_sw_para3)
+    CALL getin_p('TURN_SW_PARA4',turn_sw_para4)
+    CALL getin_p('TURN_SW_PARA5',turn_sw_para5)
+
+    CALL getin_p('TURN_FRA_PARA1',turn_fra_para1)
+    CALL getin_p('TURN_FRA_PARA2',turn_fra_para2)
+    CALL getin_p('TURN_FRA_PARA3',turn_fra_para3)
+    CALL getin_p('TURN_FRA_PARA4',turn_fra_para4)
+
+    CALL getin_p('ALLOC_PARA1',alloc_para1)
+    CALL getin_p('ALLOC_PARA2',alloc_para2)
+    CALL getin_p('ALLOC_PARA3',alloc_para3)
+
+    CALL getin_p('TURN_SCALE_PARA1',turn_scale_para1)
+    CALL getin_p('TURN_SCALE_PARA2',turn_scale_para2)
+    CALL getin_p('TURN_SCALE_PARA3',turn_scale_para3)
+    
+    CALL getin_p('TURN_SCALE_PARA4',turn_scale_para4)
+    CALL getin_p('TURN_SCALE_PARA5',turn_scale_para5)
+    CALL getin_p('TURN_SCALE_PARA6',turn_scale_para6)
+
+    !-
+    ! vmax parameters
+    !-
+    !
+    !Config Key   = VMAX_OFFSET 
+    !Config Desc  = offset (minimum relative vcmax)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.3
+    !Config Help  = offset (minimum vcmax/vmax_opt)
+    !Config Units = [-]  
+    CALL getin_p('VMAX_OFFSET',vmax_offset)
+    !
+    !Config Key   = LEAFAGE_FIRSTMAX
+    !Config Desc  = leaf age at which vmax attains vcmax_opt (in fraction of critical leaf age)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.03 
+    !Config Help  = relative leaf age at which vmax attains vcmax_opt
+    !Config Units = [-] 
+    CALL getin_p('LEAFAGE_FIRSTMAX',leafage_firstmax)
+    !
+    !Config Key   = LEAFAGE_LASTMAX 
+    !Config Desc  = leaf age at which vmax falls below vcmax_opt (in fraction of critical leaf age) 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5 
+    !Config Help  = relative leaf age at which vmax falls below vcmax_opt
+    !Config Units = [-]  
+    CALL getin_p('LEAFAGE_LASTMAX',leafage_lastmax)
+    !
+    !Config Key   = LEAFAGE_OLD 
+    !Config Desc  = leaf age at which vmax attains its minimum (in fraction of critical leaf age)
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.
+    !Config Help  = relative leaf age at which vmax attains its minimum
+    !Config Units = [-]  
+    CALL getin_p('LEAFAGE_OLD',leafage_old)
+
+    !-
+    ! season parameters
+    !-
+    !
+    !Config Key   = GPPFRAC_DORMANCE 
+    !Config Desc  = rapport maximal GPP/GGP_max pour dormance
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.2 
+    !Config Help  = 
+    !Config Units = [-]
+    CALL getin_p('GPPFRAC_DORMANCE',gppfrac_dormance)
+    !
+    !Config Key   = TAU_CLIMATOLOGY
+    !Config Desc  = tau for "climatologic variables 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 20
+    !Config Help  = 
+    !Config Units = [days]
+    CALL getin_p('TAU_CLIMATOLOGY',tau_climatology)
+    !
+    !Config Key   = HVC1 
+    !Config Desc  = parameters for herbivore activity
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.019
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('HVC1',hvc1)
+    !
+    !Config Key   = HVC2 
+    !Config Desc  = parameters for herbivore activity 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 1.38
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('HVC2',hvc2)
+    !
+    !Config Key   = LEAF_FRAC_HVC
+    !Config Desc  = parameters for herbivore activity 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.33
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('LEAF_FRAC_HVC',leaf_frac_hvc)
+    !
+    !Config Key   = TLONG_REF_MAX
+    !Config Desc  = maximum reference long term temperature 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 303.1
+    !Config Help  = 
+    !Config Units = [K]  
+    CALL getin_p('TLONG_REF_MAX',tlong_ref_max)
+    !
+    !Config Key   = TLONG_REF_MIN 
+    !Config Desc  = minimum reference long term temperature 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 253.1
+    !Config Help  = 
+    !Config Units = [K]  
+    CALL getin_p('TLONG_REF_MIN',tlong_ref_min)
+    !
+    !Config Key   = NCD_MAX_YEAR
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 3. 
+    !Config Help  = NCD : Number of Chilling Days
+    !Config Units = [days]
+    CALL getin_p('NCD_MAX_YEAR',ncd_max_year)
+    !
+    !Config Key   = GDD_THRESHOLD 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 5. 
+    !Config Help  = GDD : Growing-Degree-Day
+    !Config Units = [days] 
+    CALL getin_p('GDD_THRESHOLD',gdd_threshold)
+    !
+    !Config Key   = GREEN_AGE_EVER 
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 2. 
+    !Config Help  = 
+    !Config Units = [-]  
+    CALL getin_p('GREEN_AGE_EVER',green_age_ever)
+    !
+    !Config Key   = GREEN_AGE_DEC
+    !Config Desc  = 
+    !Config If    = OK_STOMATE 
+    !Config Def   = 0.5 
+    !Config Help  = 
+    !Config Units = [-] 
+    CALL getin_p('GREEN_AGE_DEC',green_age_dec)
+
+  END SUBROUTINE config_stomate_parameters
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_dgvm_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when the DGVM model is activated (ie : when ok_dgvm is set to true).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_dgvm_parameters   
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables
+
+    !_ ================================================================================================================================    
+
+    !-
+    ! 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(i_std)               :: 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]
+    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-AFP/src_parameters/constantes_mtc.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_mtc.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_mtc.f90	(revision 8430)
@@ -0,0 +1,768 @@
+! =================================================================================================================================
+! MODULE       : constantes_mtc
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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.
+!! - MacBean, N., Maignan, F., Peylin, P., Bacour, C., Breon, F. M., & Ciais, P. (2015). Using satellite data to improve the leaf 
+!! phenology of a global terrestrial biosphere model. Biogeosciences, 12(23), 7185-7208.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_mtc
+
+  USE defprec
+  USE constantes
+
+  IMPLICIT NONE
+
+  !
+  ! METACLASSES CHARACTERISTICS
+  !
+
+  INTEGER(i_std), PARAMETER :: nvmc = 13                         !! Number of MTCS fixed in the code (unitless)
+
+  CHARACTER(len=34), PARAMETER, DIMENSION(nvmc) :: MTC_name = &  !! description of the MTC (unitless)
+  & (/ 'bare ground                       ', &          !  1
+  &    'tropical  broad-leaved evergreen  ', &          !  2
+  &    'tropical  broad-leaved raingreen  ', &          !  3
+  &    'temperate needleleaf   evergreen  ', &          !  4
+  &    'temperate broad-leaved evergreen  ', &          !  5
+  &    'temperate broad-leaved summergreen', &          !  6
+  &    'boreal    needleleaf   evergreen  ', &          !  7
+  &    'boreal    broad-leaved summergreen', &          !  8
+  &    'boreal    needleleaf   summergreen', &          !  9
+  &    '          C3           grass      ', &          ! 10
+  &    '          C4           grass      ', &          ! 11
+  &    '          C3           agriculture', &          ! 12
+  &    '          C4           agriculture'  /)         ! 13
+
+
+  !
+  ! VEGETATION STRUCTURE
+  !
+  INTEGER(i_std),PARAMETER, DIMENSION(nvmc) :: leaf_tab_mtc  =  &                 !! leaf type (1-4, unitless)
+  & (/  4,   1,   1,   2,   1,   1,   2,   &                                      !! 1=broad leaved tree, 2=needle leaved tree
+  &     1,   2,   3,   3,   3,   3   /)                                           !! 3=grass 4=bare ground
+
+  CHARACTER(len=6), PARAMETER, DIMENSION(nvmc) :: pheno_model_mtc  =  &  !! which phenology model is used? (tabulated) 
+  & (/  'none  ',   'none  ',   'moi   ',   'none  ',   'none  ',  &
+  &     'ncdgdd',   'none  ',   'ncdgdd',   'ngd   ',   'moigdd',  &
+  &     'moigdd',   'moigdd',   'moigdd'  /) 
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_tropical_mtc  =  &                       !! Is PFT tropical ? (true/false)
+  & (/ .FALSE.,   .TRUE.,    .TRUE.,    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &
+  &    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE. /)    
+
+  CHARACTER(LEN=5), PARAMETER, DIMENSION(nvmc) :: type_of_lai_mtc  =  &  !! Type of behaviour of the LAI evolution algorithm
+  & (/ 'inter', 'inter', 'inter', 'inter', 'inter',  &                   !! for each vegetation type. (unitless)
+  &    'inter', 'inter', 'inter', 'inter', 'inter',  &                   !! Value of type_of_lai : mean or interp
+  &    'inter', 'inter', 'inter' /)
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: natural_mtc =  &                         !! natural?  (true/false)
+  & (/ .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,    .TRUE.,   .TRUE.,  &
+  &    .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .FALSE.,   .FALSE.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: veget_ori_fixed_mtc  =  &  !! Value for veget_ori for tests in
+  & (/ 0.2,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                !! 0-dim simulations (0-1, unitless)
+  &    0.0,   0.0,   0.8,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: llaimax_mtc  =  &          !! laimax for maximum
+  & (/ 0.0,   8.0,   8.0,   4.0,   4.5,   4.5,   4.0,  &                !! See also type of lai interpolation
+  &    4.5,   4.0,   2.0,   2.0,   2.0,   2.0  /)                       !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: llaimin_mtc  = &           !! laimin for minimum lai
+  & (/ 0.0,   8.0,   0.0,   4.0,   4.5,   0.0,   4.0,  &                !! See also type of lai interpolation (m^2.m^{-2})
+  &    0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                       !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: height_presc_mtc  =  &     !! prescribed height of vegetation (m)
+  & (/  0.0,   30.0,   30.0,   20.0,   20.0,   20.0,   15.0,  &         !! Value for height_presc : one for each vegetation type
+  &    15.0,   15.0,    0.5,    0.6,    1.0,    1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: 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   /)
+ !! liulyt no change No.3 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: sla_mtc  =  &                       !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex
+  & (/ 1.5E-2,   1.53E-2,   2.6E-2,   9.26E-3,     2E-2,   2.6E-2,   9.26E-3,  &
+  &    2.6E-2,    1.9E-2,   2.6E-2,    2.6E-2,   2.6E-2,   2.6E-2  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: availability_fact_mtc  =  &     !! calculate mortality in lpj_gap
+  & (/ undef,   0.14,  0.14,   0.10,   0.10,   0.10,   0.05,  &
+  &     0.05,   0.05,  undef,  undef,  undef,  undef  /)
+
+  !
+  ! EVAPOTRANSPIRATION (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: rstruct_const_mtc  =  &  !! Structural resistance.
+  & (/ 0.0,   25.0,   25.0,   25.0,   25.0,   25.0,   25.0,  &        !! @tex $(s.m^{-1})$ @endtex
+  &   25.0,   25.0,    2.5,    2.0,    2.0,    2.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: kzero_mtc  =  &                  !! A vegetation dependent constant used in the 
+  & (/    0.0,   12.E-5,   12.E-5,   12.E-5,   12.E-5,   25.E-5,   12.E-5,  & !! calculation  of the surface resistance. 
+  &    25.E-5,   25.E-5,   30.E-5,   30.E-5,   30.E-5,   30.E-5  /)           !! @tex $(kg.m^2.s^{-1})$ @endtex
+
+
+  !
+  ! WATER (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: wmax_veg_mtc  =  &        !! Volumetric available soil water capacity in each PFT
+  & (/ 150.0,   150.0,   150.0,   150.0,   150.0,   150.0,   150.0,  & !! @tex $(kg.m^{-3} of soil)$ @endtex
+  &    150.0,   150.0,   150.0,   150.0,   150.0,   150.0  /)         
+                                                                      
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_ref4m  =  &       !! Root profile description for the different 
+  & (/ 5.0,   0.4,   0.4,   1.0,   0.8,   0.8,   1.0,  &               !! vegetations types. @tex $(m^{-1})$ @endtex
+  &    1.0,   0.8,   4.0,   1.0,   4.0,   1.0  /)                      !! These are the factor in the exponential which gets       
+                                                                       !! the root density as a function of depth
+                                                                       !! Values for zmaxh = 4.0  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_ref2m  =  &       !! Root profile description for the different
+  & (/ 5.0,   0.8,   0.8,   1.0,   0.8,   0.8,   1.0,  &               !! vegetations types.  @tex $(m^{-1})$ @endtex
+  &    1.0,   0.8,   4.0,   4.0,   4.0,   4.0  /)                      !! These are the factor in the exponential which gets       
+                                                                       !! the root density as a function of depth
+                                                                       !! Values for zmaxh = 2.0
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: throughfall_by_mtc  =  &  !! Percent by PFT of precip that is not 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_vis_mtc  =  &  !! Minimum snow albedo value for each vegetation type
+  & (/ 0.74,    0.0,    0.0,   0.08,   0.24,   0.07,   0.18,  &        !! after aging (dirty old snow) (unitless), visible albedo
+  &    0.18,    0.33,   0.57,  0.57,   0.57,   0.57  /)                !! Source : Values optimized for ORCHIDEE2.0
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_aged_nir_mtc  =  &  !! Minimum snow albedo value for each vegetation type
+  & (/ 0.50,    0.0,    0.0,   0.10,   0.37,   0.08,   0.16,  &        !! after aging (dirty old snow) (unitless), near infrared albedo
+  &    0.17,    0.27,   0.44,   0.44,   0.44,   0.44  /)               !! Source : Values optimized for ORCHIDEE2.0
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_dec_vis_mtc  =  &   !! Decay rate of snow albedo value for each vegetation type
+  & (/ 0.21,   0.0,    0.0,   0.14,   0.08,   0.17,   0.05,  &         !! as it will be used in condveg_snow (unitless), visible albedo
+  &    0.06,   0.09,   0.15,  0.15,   0.15,   0.15  /)                 !! Source : Values optimized for ORCHIDEE2.0
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_dec_nir_mtc  =  &   !! Decay rate of snow albedo value for each vegetation type
+  & (/ 0.13,    0.0,    0.0,   0.10,   0.10,   0.16,   0.04,  &        !! as it will be used in condveg_snow (unitless), near infrared albedo
+  &    0.07,    0.08,   0.12,  0.12,   0.12,   0.12  /)                !! Source : Values optimized for ORCHIDEE2.0
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alb_leaf_vis_mtc  =  &    !! leaf albedo of vegetation type, visible albedo, optimized on 04/07/2016
+  & (/ 0.00,   0.04, 0.04, 0.04, 0.04, 0.03, 0.03,  &                  !! (unitless)
+  &    0.03,   0.03, 0.06, 0.06, 0.06, 0.06  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alb_leaf_nir_mtc  =  &    !! leaf albedo of vegetation type, near infrared albedo, optimized on 04/07/2016
+  & (/ 0.00,   0.23,  0.18,  0.18,  0.20,  0.24,  0.15,  &             !! (unitless)
+  &    0.26,   0.20,  0.24,  0.27,  0.28,  0.26  /)
+
+  !
+  ! SOIL - VEGETATION
+  !
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: pref_soil_veg_mtc  =  &       !! The soil tile number for each vegetation
+  & (/ 1,   2,   2,   2,   2,   2,   2,  &                                    
+  &    2,   2,   3,   3,   3,   3  /)                                         
+
+
+  !
+  ! PHOTOSYNTHESIS
+  !
+  !-
+  ! 1 .CO2
+  !-
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_c4_mtc  =  &                            !! flag for C4 vegetation types (true/false)
+  & (/ .FALSE.,  .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &
+  &    .FALSE.,  .FALSE.,   .FALSE.,   .TRUE.,    .FALSE.,   .TRUE.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: vcmax_fix_mtc  =  &     !! values used for vcmax when STOMATE is not
+  & (/  0.0,   40.0,   50.0,   30.0,   35.0,   40.0,   30.0,  &      !! activated @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+  &    40.0,   35.0,   60.0,   60.0,   70.0,   70.0  /)
+
+! For C4 plant we define a very small downregulation effect as C4 plant are
+! currently saturate with respect to CO2 impact on vcmax
+  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.03,   0.26,   0.03 /)
+
+  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.  /)           
+  !! liulyw nochange xchen PFT 2 AND 3
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: Vcmax25_mtc  =  &          !! Maximum rate of Rubisco activity-limited carboxylation at 25Â°C
+  & (/ undef,   45.0,    45.0,    35.0,   40.0,   50.0,   45.0,  &      !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+  &     35.0,   35.0,    50.0,    50.0,   60.0,   60.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
+  & (/    1.,     1.,     1.,       1.,      1.,     1.,      1., &
+  &      1.,     1.,     1.,       1.,      1.,     1.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: stress_gm_mtc = &          !! Water stress on gm
+  & (/    1.,     1.,     1.,       1.,      1.,     1.,      1., &
+  &      1.,     1.,     1.,       1.,      1.,     1.  /)
+    
+  !-
+  ! 2 .Stomate
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ext_coeff_mtc  =  &     !! extinction coefficient of the Monsi&Saeki
+  & (/ 0.5,   0.5,   0.5,   0.5,   0.5,   0.5,   0.5,  &             !! relationship (1953) (unitless)
+  &    0.5,   0.5,   0.5,   0.5,   0.5,   0.5  /)
+  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  /)
+
+  !
+  ! 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.35,   0.35,   0.28,   0.28,   0.28,   0.35,  &
+  &      0.35,   0.35,   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.12,   0.12,   0.16,   0.16,   0.16,   0.25,  &          !! constant c of aT^2+bT+c, tabulated
+  &      0.25,   0.25,   0.16,   0.12,   0.16,   0.12  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_b_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.0,        0.0,   0.0,        0.0,   0.0,   0.0,  &      !! constant b of aT^2+bT+c, tabulated
+  &       0.0,   0.0,   -0.00133,   0.0,   -0.00133,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_a_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                !! constant a of aT^2+bT+c, tabulated
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_leaf_mtc  =   &                  !! maintenance respiration coefficient
+  & (/   undef,   2.35E-3,   2.62E-3,   1.01E-3,   2.35E-3,   2.62E-3,   1.01E-3,  &  !! at 0 deg C,for leaves, tabulated, 
+  &    2.62E-3,   2.05E-3,   2.62E-3,   2.62E-3,   2.62E-3,   2.62E-3  /)             !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_sapabove_mtc =  &                !! maintenance respiration coefficient 
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for sapwood above,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_sapbelow_mtc  =  &               !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for sapwood below, 
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_heartabove_mtc  =  &             !! maintenance respiration coefficient
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                           !! at 0 deg C, for heartwood above,
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                                  !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_heartbelow_mtc  =  &             !! maintenance respiration coefficient
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                           !! at 0 deg C, for heartwood below, 
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                                  !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_root_mtc  =  &                   !! maintenance respiration coefficient
+  & (/   undef,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,  &  !! at 0 deg C, for roots, tabulated,
+  &    1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3  /)             !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_fruit_mtc  =  &                  !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for fruits, tabulated,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !!  @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_carbres_mtc  =  &                !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for carbohydrate reserve,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+
+  !
+  ! FIRE (stomate)
+  !
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: flam_mtc  =  &         !! flamability: critical fraction of water 
+  & (/  undef,   0.15,   0.25,   0.25,   0.25,   0.25,   0.25,  &  !! holding capacity (0-1, unitless)
+  &      0.25,   0.25,   0.25,   0.25,   0.35,   0.35  /)
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: resist_mtc  =  &       !! fire resistance (0-1, unitless)
+  & (/ undef,   0.95,   0.90,   0.90,   0.90,   0.90,   0.90,  &
+  &    0.90,    0.90,    0.0,    0.0,    0.0,    0.0 /) 
+
+
+  !
+  ! FLUX - LUC
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_1_mtc  =  &   !! Coeff of biomass export for the year
+  & (/  undef,   0.897,   0.897,   0.597,   0.597,   0.597,   0.597,  &   !! (0-1, unitless)
+  &     0.597,   0.597,   0.597,   0.597,   0.597,   0.597  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_10_mtc  =  &  !! Coeff of biomass export for the decade 
+  & (/  undef,   0.103,   0.103,   0.299,   0.299,   0.299,   0.299,  &   !! (0-1, unitless)
+  &     0.299,   0.299,   0.299,   0.403,   0.299,   0.403  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_100_mtc  =  & !! Coeff of biomass export for the century
+  & (/  undef,     0.0,     0.0,   0.104,   0.104,   0.104,   0.104,  &   !! (0-1, unitless)
+  &     0.104,   0.104,   0.104,     0.0,   0.104,     0.0  /)
+
+
+  !
+  ! PHENOLOGY
+  !
+  ! The latest modifications regarding leafagecrit, senescence_temp_c, leaffall, hum_min_time and nosenescence_hum are inspired by
+  ! MacBean et al. (2015), following the optimization of phenology parameters using MODIS NDVI (FM/PP).
+  !-
+  ! 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,   5.0,   5.0,   4.0,   5.0,   3.5,  &               !! @tex $(m^2.m^{-2})$ @endtex
+  &      4.0,   3.0,   2.5,   2.0,   5.0,   5.0  /)
+
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: pheno_type_mtc  =  &     !! type of phenology (0-4, unitless)
+  & (/  0,   1,   3,   1,   1,   2,   1,  &                              !! 0=bare ground 1=evergreen,  2=summergreen, 
+  &     2,   2,   4,   4,   2,   3  /)                                   !! 3=raingreen,  4=perennial
+  !-
+  ! 2. Leaf Onset
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_c_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! constant c of aT^2+bT+c
+  &     undef,   undef,   320.0,   400.0,   320.0,   700.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_b_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! constant b of aT^2+bT+c
+  &     undef,   undef,    6.25,     0.0,    6.25,     0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_a_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,     undef,   undef,   undef,   undef,   undef,  &  !! constant a of aT^2+bT+c
+  &     undef,   undef,   0.03125,     0.0,  0.0315,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_moigdd_t_crit_mtc  = &  !! temperature threshold for C4 grass(C)
+  & (/  undef,   undef,     undef,   undef,   undef,   undef,   undef,  &  
+  &     undef,   undef,     undef,    22.0,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ngd_crit_mtc  =  &            !! critical ngd, tabulated. 
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! Threshold -5 degrees (days)
+  &     undef,    17.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ncdgdd_temp_mtc  =  &         !! critical temperature for the ncd vs. gdd 
+  & (/  undef,   undef,   undef,   undef,   undef,     5.0,   undef,  &    !! function in phenology (C)
+  &       0.0,   undef,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: hum_frac_mtc  =  &            !! critical humidity (relative to min/max) 
+  & (/  undef,   undef,   0.5,   undef,   undef,   undef,   undef, &       !! for phenology (unitless)
+  &     undef,   undef,   0.5,     0.5,     0.5,     0.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: hum_min_time_mtc  =  &        !! minimum time elapsed since
+  & (/  undef,   undef,   50.0,   undef,   undef,   undef,   undef,  &     !! moisture minimum (days)
+  &     undef,   undef,   36.0,    35.0,    75.0,    75.0  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_sap_mtc  =  &             !! time (days)  
+  & (/  undef,   730.0,   730.0,   730.0,   730.0,   730.0,   730.0,  &
+  &     730.0,   730.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_leafinit_mtc  =  &  !! time to attain the initial foliage using the carbohydrate reserve
+  & (/  undef,   10.,   10.,   10.,   10.,   10.,   10.,  &
+  &       10.,   10.,   10.,   10.,   10.,   10.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_fruit_mtc  =  &           !! fruit lifetime (days)
+  & (/  undef,  90.0,    90.0,    90.0,    90.0,   90.0,   90.0,  &
+  &      90.0,  90.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ecureuil_mtc  =  &            !! fraction of primary leaf and root allocation
+  & (/  undef,   0.0,   1.0,   0.0,   0.0,   1.0,   0.0,  &                !! put into reserve (0-1, unitless)
+  &       1.0,   1.0,   1.0,   1.0,   1.0,   1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alloc_min_mtc  =  &           !! NEW - allocation above/below = f(age) 
+  & (/  undef,   0.2,     0.2,     0.2,     0.2,    0.2,   0.2,  &         !! - 30/01/04 NV/JO/PF
+  &       0.2,   0.2,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alloc_max_mtc  =  &           !! NEW - allocation above/below = f(age) 
+  & (/  undef,   0.8,     0.8,     0.8,     0.8,    0.8,   0.8,  &         !! - 30/01/04 NV/JO/PF
+  &       0.8,   0.8,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: demi_alloc_mtc  =  &          !! NEW - allocation above/below = f(age) 
+  & (/  undef,   5.0,     5.0,     5.0,     5.0,    5.0,   5.0,  &         !! - 30/01/04 NV/JO/PF
+  &       5.0,   5.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaflife_mtc  =  &            !! leaf longevity, tabulated (??units??)
+  & (/  undef,   0.5,   2.0,   0.33,   1.0,   2.0,   0.33,  &
+  &       2.0,   2.0,   2.0,   2.0,    2.0,   2.0  /)
+  !-
+  ! 3. Senescence
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaffall_mtc  =  &             !! length of death of leaves, tabulated (days)
+  & (/  undef,   undef,   10.0,   undef,   undef,   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,   160.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 ',  'mixed ',   'mixed '            /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_hum_mtc  =  &       !! critical relative moisture availability
+  & (/  undef,   undef,   0.3,   undef,   undef,   undef,   undef,  &       !! for senescence (0-1, unitless)
+  &     undef,   undef,   0.2,     0.2,     0.3,     0.2  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: nosenescence_hum_mtc  =  &     !! relative moisture availability above which 
+  & (/  undef,   undef,   0.8,   undef,   undef,   undef,   undef,  &       !! there is no humidity-related senescence
+  &     undef,   undef,   0.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) :: 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.  /)
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: always_init_mtc  =  &              !! take carbon from atmosphere if carbohydrate reserve too small (true/false)
+  & (/ .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .TRUE., &!! default is true for all pfts except pft=11 C4 grass
+  &    .TRUE.,   .TRUE.,   .TRUE.,   .FALSE.,   .TRUE.,   .TRUE. /)    
+
+
+  !
+  ! DGVM
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: residence_time_mtc  =  &    !! residence time of trees (years)
+  & (/  undef,   30.0,   30.0,   40.0,   40.0,   40.0,   80.0,  &
+  &      80.0,   80.0,    0.0,    0.0,    0.0,    0.0  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tmin_crit_mtc  =  &
+  & (/  undef,     0.0,     0.0,   -30.0,   -14.0,   -30.0,   -45.0,  &  !! critical tmin, tabulated (C)
+  &     -45.0,   -60.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tcm_crit_mtc  =  &
+  & (/  undef,   undef,   undef,     5.0,    15.5,    15.5,   -8.0,  &   !! critical tcm, tabulated (C)
+  &      -8.0,    -8.0,   undef,   undef,   undef,   undef  /)
+
+
+
+  !
+  ! Biogenic Volatile Organic Compounds
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_isoprene_mtc = &     !! Isoprene emission factor 
+  & (/  0.,    24.,   24.,    8.,   16.,   45.,   8.,  &                    !!
+  &    18.,    0.5,   12.,   18.,    5.,    5.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_monoterpene_mtc = &  !! Monoterpene emission factor
+  & (/   0.,   2.0,    2.0,   1.8,    1.4,    1.6,    1.8,  &               !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    1.4,    1.8,    0.8,   0.8,    0.22,     0.22  /)
+
+  REAL(r_std), PARAMETER :: LDF_mono_mtc = 0.6                                  !! monoterpenes fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_sesq_mtc = 0.5                                  !! sesquiterpenes fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_meth_mtc = 0.8                                  !! methanol fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_acet_mtc = 0.2                                  !! acetone fraction dependancy to light
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_apinene_mtc = &      !! Alfa pinene emission factor percentage
+  & (/   0.,   0.395,   0.395,   0.354,   0.463,   0.326,   0.354, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.316,   0.662,   0.231,   0.200,   0.277,   0.277 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_bpinene_mtc = &      !! Beta pinene emission factor  percentage      
+  & (/   0.,   0.110,   0.110,   0.146,   0.122,   0.087,   0.146, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.063,   0.150,   0.123,   0.080,   0.154,   0.154  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_limonene_mtc = &     !! Limonene emission factor percentage
+  & (/   0.,   0.092,   0.092,   0.083,   0.122,   0.061,   0.083, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.071,   0.037,   0.146,   0.280,   0.092,   0.092  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_myrcene_mtc = &      !! Myrcene emission factor percentage
+  & (/   0.,   0.073,   0.073,   0.050,   0.054,   0.028,   0.050, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.019,   0.025,   0.062,   0.057,   0.046,   0.046  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_sabinene_mtc = &     !! Sabinene emission factor percentage
+  & (/   0.,   0.073,   0.073,   0.050,   0.083,   0.304,   0.050, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.263,   0.030,   0.065,   0.050,   0.062,   0.062  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_camphene_mtc = &     !! Camphene emission factor percentage
+  & (/   0.,   0.055,   0.055,   0.042,   0.049,   0.004,   0.042, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.005,   0.023,   0.054,   0.053,   0.031,   0.031  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_3carene_mtc = &      !! 3-carene emission factor percentage
+  & (/   0.,   0.048,   0.048,   0.175,   0.010,   0.024,   0.175, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.013,   0.042,   0.065,   0.057,   0.200,   0.200  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_tbocimene_mtc = &    !! T-beta-ocimene emission factor percentage
+  & (/   0.,   0.092,   0.092,   0.054,   0.044,   0.113,   0.054, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.105,   0.028,   0.138,   0.120,   0.031,   0.031  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_othermonot_mtc = &   !! Other monoterpenes emission factor percentage
+  & (/   0.,   0.062,   0.062,   0.046,   0.054,   0.052,   0.046, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.144,   0.003,   0.115,   0.103,   0.108,   0.108  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_sesquiterp_mtc = &   !! Sesquiterpene emission factor
+  & (/   0.,  0.45,   0.45,   0.13,   0.30,   0.36,   0.15, &               !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    0.30,  0.25,   0.60,   0.60,   0.08,   0.08  /)
+
+  REAL(r_std), PARAMETER :: beta_mono_mtc = 0.10                            !! Monoterpenes temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_sesq_mtc = 0.17                            !! Sesquiterpenes temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_meth_mtc = 0.08                            !! Methanol temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_acet_mtc = 0.10                            !! Acetone temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_oxyVOC_mtc = 0.13                          !! Other oxygenated BVOC temperature dependency coefficient 
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_ORVOC_mtc = &        !! ORVOC emissions factor 
+  &  (/  0.,    1.5,    1.5,    1.5,    1.5,   1.5,    1.5,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     1.5,    1.5,    1.5,    1.5,    1.5,   1.5  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_OVOC_mtc = &         !! OVOC emissions factor 
+  &  (/  0.,    1.5,    1.5,    1.5,    1.5,   1.5,    1.5,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     1.5,    1.5,    1.5,    1.5,    1.5,   1.5  /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_MBO_mtc = &          !! MBO emissions factor
+  & (/     0., 2.e-5, 2.e-5,   1.4, 2.e-5, 2.e-5, 0.14,  &                  !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_methanol_mtc = &     !! Methanol emissions factor 
+  & (/  0.,    0.8,   0.8,   1.8,   0.9,   1.9,   1.8,  &                   !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    1.8,    1.8,   0.7,   0.9,    2.,     2.  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetone_mtc = &      !! Acetone emissions factor
+  & (/  0.,   0.25,   0.25,   0.30,   0.20,   0.33,   0.30,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.25,   0.25,   0.20,   0.20,   0.08,   0.08  /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetal_mtc = &       !! Acetaldehyde emissions factor 
+  & (/  0.,   0.2,    0.2,     0.2,   0.2,   0.25,   0.25,   0.16,   &      !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.16,   0.12,   0.12,   0.035,   0.020  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_formal_mtc = &       !! Formaldehyde emissions factor
+  & (/  0.,   0.04,   0.04,  0.08,    0.04,    0.04,  0.04,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.04,   0.04,  0.025, 0.025,   0.013,   0.013  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetic_mtc = &       !! Acetic Acid emissions factor
+  & (/   0.,   0.025,   0.025,   0.025,   0.022,   0.08,   0.025,   &      !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.022,   0.013,   0.012,   0.012,   0.008,   0.008  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_formic_mtc = &       !! Formic Acid emissions factor
+  & (/  0.,  0.015,  0.015,   0.02,    0.02,   0.025,  0.025,  &            !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &  0.015,  0.015,  0.010,  0.010,   0.008,   0.008  /)  
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: em_factor_no_wet_mtc = &        !! NOx emissions factor soil emissions and exponential
+  & (/  0.,   2.6,   0.06,   0.03,   0.03,   0.03,   0.03,  &               !! dependancy factor for wet soils
+  &  0.03,   0.03,   0.36,   0.36,   0.36,   0.36  /)                       !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: em_factor_no_dry_mtc = &        !! NOx emissions factor soil emissions and exponential
+  & (/  0.,   8.60,   0.40,   0.22,   0.22,   0.22,   0.22,  &              !! dependancy factor for dry soils
+  &   0.22,   0.22,   2.65,   2.65,   2.65,   2.65  /)                      !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: Larch_mtc = &                  !! Larcher 1991 SAI/LAI ratio (unitless)
+  & (/   0.,   0.015,   0.015,   0.003,   0.005,   0.005,   0.003,  &
+  &   0.005,   0.003,   0.005,   0.005,   0.008,   0.008  /)  
+
+
+
+END MODULE constantes_mtc
Index: /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_soil.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_soil.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_soil.f90	(revision 8430)
@@ -0,0 +1,356 @@
+! =================================================================================================================================
+! MODULE 	: constantes_soil
+!
+! CONTACT       : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
+!!
+!!\n DESCRIPTION : "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
+!!                 This module alos USE constates_soil and can therfor be used to acces the subroutines and the constantes.
+!!                 The constantes declarations can also be used seperatly with "USE constantes_soil_var".
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_soil
+
+  USE constantes_soil_var
+  USE constantes
+  USE ioipsl_para 
+
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_soil_parameters
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters related to soil and hydrology. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_soil_parameters()
+
+    USE ioipsl
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables 
+
+    INTEGER(i_std), PARAMETER      :: error_level = 3         !! Switch to 2 to turn fatal errors into warnings.(1-3, unitless)
+    LOGICAL                        :: 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    = 
+       !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.02
+       !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  = TRUE
+    !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 = .TRUE.
+    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  = OK_FREEZE_THAW_LATENT_HEAT
+    !Config Desc = Activate latent heat part of the soil freezing scheme
+    !Config If   = 
+    !Config Def  = FALSE 
+    !Config Help = 
+    !Config Units= [FLAG]
+
+    ok_freeze_thaw_latent_heat = .FALSE.
+    CALL getin_p ('OK_FREEZE_THAW_LATENT_HEAT',ok_freeze_thaw_latent_heat)
+
+
+    !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 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-AFP/src_parameters/constantes_soil_var.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_soil_var.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_soil_var.f90	(revision 8430)
@@ -0,0 +1,276 @@
+! =================================================================================================================================
+! MODULE 	: constantes_soil_var
+!
+! CONTACT       : orchidee-help _at_ listes.ipsl.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)
+
+  !! 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.02                  !! 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
+!$OMP THREADPRIVATE(ok_Ecorr)
+  LOGICAL, SAVE        :: ok_freeze_thermix           !! Flag to activate thermal part of the soil freezing scheme
+!$OMP THREADPRIVATE(ok_freeze_thermix)
+  LOGICAL, SAVE        :: ok_freeze_thaw_latent_heat  !! Flag to activate latent heat part of the soil freezing scheme
+!$OMP THREADPRIVATE(ok_freeze_thaw_latent_heat)
+  LOGICAL, SAVE        :: read_reftemp                !! Flag to initialize soil temperature using climatological temperature
+!$OMP THREADPRIVATE(read_reftemp)
+  REAL(r_std), SAVE    :: poros                       !! Soil porosity (from USDA classification, mean value)(-)
+!$OMP THREADPRIVATE(poros)
+  REAL(r_std), SAVE    :: fr_dT                       !! Freezing window (K)
+!$OMP THREADPRIVATE(fr_dT)
+
+  !! Variables related to soil freezing, in hydrol : 
+  LOGICAL, SAVE        :: ok_freeze_cwrr              !! CWRR freezing scheme by I. Gouttevin
+!$OMP THREADPRIVATE(ok_freeze_cwrr)
+  LOGICAL, SAVE        :: ok_thermodynamical_freezing !! Calculate frozen fraction thermodynamically
+!$OMP THREADPRIVATE(ok_thermodynamical_freezing)
+
+  
+END MODULE constantes_soil_var
Index: /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_var.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_var.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/constantes_var.f90	(revision 8430)
@@ -0,0 +1,1212 @@
+! =================================================================================================================================
+! MODULE       : constantes_var
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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, SAVE :: ok_nudge_mc  !! Activate nudging of soil moisture 
+!$OMP THREADPRIVATE(ok_nudge_mc)
+  LOGICAL, SAVE :: ok_nudge_snow!! Activate nudging of snow variables
+!$OMP THREADPRIVATE(ok_nudge_snow)
+  LOGICAL, SAVE :: nudge_interpol_with_xios  !! Activate reading and interpolation with XIOS for nudging fields
+!$OMP THREADPRIVATE(nudge_interpol_with_xios)
+  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_dgvm            !! activate dynamic vegetation
+!$OMP THREADPRIVATE(ok_dgvm)
+  LOGICAL :: do_wood_harvest    !! activate wood harvest
+!$OMP THREADPRIVATE(do_wood_harvest)
+  LOGICAL :: ok_pheno           !! activate the calculation of lai using stomate rather than a prescription
+!$OMP THREADPRIVATE(ok_pheno)
+  LOGICAL :: ok_bvoc            !! activate biogenic volatile organic coumpounds
+!$OMP THREADPRIVATE(ok_bvoc)
+  LOGICAL :: ok_leafage         !! activate leafage
+!$OMP THREADPRIVATE(ok_leafage)
+  LOGICAL :: ok_radcanopy       !! use canopy radiative transfer model
+!$OMP THREADPRIVATE(ok_radcanopy)
+  LOGICAL :: ok_multilayer      !! use canopy radiative transfer model with multi-layers
+!$OMP THREADPRIVATE(ok_multilayer)
+  LOGICAL :: ok_pulse_NOx       !! calculate NOx emissions with pulse
+!$OMP THREADPRIVATE(ok_pulse_NOx)
+  LOGICAL :: ok_bbgfertil_NOx   !! calculate NOx emissions with bbg fertilizing effect
+!$OMP THREADPRIVATE(ok_bbgfertil_NOx)
+  LOGICAL :: ok_cropsfertil_NOx !! calculate NOx emissions with fertilizers use
+!$OMP THREADPRIVATE(ok_cropsfertil_NOx)
+
+  LOGICAL :: ok_co2bvoc_poss    !! CO2 inhibition on isoprene activated following Possell et al. (2005) model
+!$OMP THREADPRIVATE(ok_co2bvoc_poss)
+  LOGICAL :: ok_co2bvoc_wilk    !! CO2 inhibition on isoprene activated following Wilkinson et al. (2006) model
+!$OMP THREADPRIVATE(ok_co2bvoc_wilk)
+  
+  LOGICAL, 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)
+
+  !
+  ! TIME
+  !
+  INTEGER(i_std), PARAMETER  :: spring_days_max = 40  !! Maximum number of days during which we watch for possible spring frost damage
+  !
+  ! 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)
+
+  REAL(r_std), SAVE :: alpha_nudge_mc                    !! Nudging constant for soil moisture 
+!$OMP THREADPRIVATE(alpha_nudge_mc)
+  REAL(r_std), SAVE :: alpha_nudge_snow                  !! Nudging constant for snow variables
+!$OMP THREADPRIVATE(alpha_nudge_snow)
+
+  !
+  !  DIMENSIONING AND INDICES PARAMETERS  
+  !
+  INTEGER(i_std), PARAMETER :: ibare_sechiba = 1 !! Index for bare soil in Sechiba (unitless)
+  INTEGER(i_std), PARAMETER :: ivis = 1          !! index for albedo in visible range (unitless)
+  INTEGER(i_std), PARAMETER :: inir = 2          !! index for albeod i near-infrared range (unitless) 
+  INTEGER(i_std), PARAMETER :: nnobio = 1        !! Number of other surface types: land ice (lakes,cities, ...) (unitless)
+  INTEGER(i_std), PARAMETER :: iice = 1          !! Index for land ice (see nnobio) (unitless)
+  !-
+  !! Soil
+  INTEGER(i_std), PARAMETER :: classnb = 9       !! Levels of soil colour classification (unitless)
+  !-
+  INTEGER(i_std), PARAMETER :: nleafages = 4     !! leaf age discretisation ( 1 = no discretisation )(unitless)
+  !-
+  !! litter fractions: indices (unitless)
+  INTEGER(i_std), PARAMETER :: ileaf = 1         !! Index for leaf compartment (unitless)
+  INTEGER(i_std), PARAMETER :: isapabove = 2     !! Index for sapwood above compartment (unitless)
+  INTEGER(i_std), PARAMETER :: isapbelow = 3     !! Index for sapwood below compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iheartabove = 4   !! Index for heartwood above compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iheartbelow = 5   !! Index for heartwood below compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iroot = 6         !! Index for roots compartment (unitless)
+  INTEGER(i_std), PARAMETER :: ifruit = 7        !! Index for fruits compartment (unitless)
+  INTEGER(i_std), PARAMETER :: icarbres = 8      !! Index for reserve compartment (unitless)
+  INTEGER(i_std), PARAMETER :: nparts = 8        !! Number of biomass compartments (unitless)
+  !-
+  !! indices for assimilation parameters 
+  INTEGER(i_std), PARAMETER :: ivcmax = 1        !! Index for vcmax (assimilation parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: npco2 = 1         !! Number of assimilation parameters (unitless)
+  !-
+  !! trees and litter: indices for the parts of heart-
+  !! and sapwood above and below the ground 
+  INTEGER(i_std), PARAMETER :: iabove = 1       !! Index for above part (unitless)
+  INTEGER(i_std), PARAMETER :: ibelow = 2       !! Index for below part (unitless)
+  INTEGER(i_std), PARAMETER :: nlevs = 2        !! Number of levels for trees and litter (unitless)
+  !-
+  !! litter: indices for metabolic and structural part
+  INTEGER(i_std), PARAMETER :: imetabolic = 1   !! Index for metabolic litter (unitless)
+  INTEGER(i_std), PARAMETER :: istructural = 2  !! Index for structural litter (unitless)
+  INTEGER(i_std), PARAMETER :: nlitt = 2        !! Number of levels for litter compartments (unitless)
+  !-
+  !! carbon pools: indices
+  INTEGER(i_std), PARAMETER :: iactive = 1      !! Index for active carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: islow = 2        !! Index for slow carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive = 3     !! Index for passive carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ncarb = 3        !! Number of soil carbon pools (unitless)
+  !-
+  !! For isotopes and nitrogen
+  INTEGER(i_std), PARAMETER :: nelements = 1    !! Number of isotopes considered
+  INTEGER(i_std), PARAMETER :: icarbon = 1      !! Index for carbon 
+  !
+  !! Indices used for analytical spin-up
+  INTEGER(i_std), PARAMETER :: nbpools = 7              !! 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 :: iactive_pool = 5         !! Index for active carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool   = 6         !! Index for slow carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool = 7        !! Index for passive carbon pool (unitless)
+  !
+  !! Indicies used for output variables on Landuse tiles defined according to LUMIP project
+  !! Note that ORCHIDEE do not represent pasture and urban land. Therefor the variables will have 
+  !! val_exp as missing value for these tiles. 
+  INTEGER(i_std), PARAMETER :: nlut=4                   !! Total number of landuse tiles according to LUMIP
+  INTEGER(i_std), PARAMETER :: id_psl=1                 !! Index for primary and secondary land
+  INTEGER(i_std), PARAMETER :: id_crp=2                 !! Index for crop land
+  INTEGER(i_std), PARAMETER :: id_pst=3                 !! Index for pasture land
+  INTEGER(i_std), PARAMETER :: id_urb=4                 !! Index for urban land
+
+
+  !
+  ! 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
+                                                            !! 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}) 
+
+
+  INTEGER(i_std), SAVE :: testpft = 6
+!$OMP THREADPRIVATE(testpft)
+  !-
+  ! 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. 
+!$OMP THREADPRIVATE(allow_forcing_write)
+
+
+
+                         !------------------------!
+                         !  SECHIBA PARAMETERS    !
+                         !------------------------!
+ 
+
+  !
+  ! GLOBAL PARAMETERS   
+  !
+  REAL(r_std), SAVE :: min_wind = 0.1      !! The minimum wind (m.s^{-1})
+!$OMP THREADPRIVATE(min_wind)
+  REAL(r_std), SAVE :: snowcri = 1.5       !! Sets the amount above which only sublimation occures (kg.m^{-2})
+!$OMP THREADPRIVATE(snowcri)
+
+
+  !
+  ! FLAGS ACTIVATING SUB-MODELS
+  !
+  LOGICAL, SAVE :: treat_expansion = .FALSE.   !! Do we treat PFT expansion across a grid point after introduction? (true/false)
+!$OMP THREADPRIVATE(treat_expansion)
+  LOGICAL, SAVE :: ok_herbivores = .FALSE.     !! flag to activate herbivores (true/false)
+!$OMP THREADPRIVATE(ok_herbivores)
+  LOGICAL, SAVE :: harvest_agri = .TRUE.       !! flag to harvest aboveground biomass from agricultural PFTs)(true/false)
+!$OMP THREADPRIVATE(harvest_agri)
+  LOGICAL, SAVE :: lpj_gap_const_mort          !! constant moratlity (true/false). Default value depend on OK_DGVM.
+!$OMP THREADPRIVATE(lpj_gap_const_mort)
+  LOGICAL, SAVE :: disable_fire = .TRUE.       !! 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 :: do_now_stomate_lcchange = .FALSE.  !! Time to call lcchange in stomate_lpj
+!$OMP THREADPRIVATE(do_now_stomate_lcchange)
+  LOGICAL, SAVE :: do_now_stomate_woodharvest = .FALSE.  !! Time to call woodharvest in stomate_lpj
+!$OMP THREADPRIVATE(do_now_stomate_woodharvest)
+  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 :: vegetmap_reset = .FALSE.!! Reset the vegetation map and reset carbon related variables
+!$OMP THREADPRIVATE(vegetmap_reset)
+  INTEGER(i_std) , SAVE :: veget_update    !! Update frequency in years for landuse (nb of years)
+!$OMP THREADPRIVATE(veget_update)
+  !
+  ! 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)
+  REAL(r_std), PARAMETER :: rho_soil = 2700.            !! Density of soil particles (kg/m3), value from Peters-Lidard et al. 1998
+
+  !! 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) 
+!$OMP THREADPRIVATE(xrhosmax)
+  REAL(r_std), SAVE         :: xwsnowholdmax1   = 0.03  ! (-) 
+!$OMP THREADPRIVATE(xwsnowholdmax1)
+  REAL(r_std), SAVE         :: xwsnowholdmax2   = 0.10  ! (-) 
+!$OMP THREADPRIVATE(xwsnowholdmax2)
+  REAL(r_std), SAVE         :: xsnowrhohold     = 200.0 ! (kg/m3) 
+!$OMP THREADPRIVATE(xsnowrhohold)
+  REAL(r_std), SAVE         :: xrhosmin = 50. 
+!$OMP THREADPRIVATE(xrhosmin)
+  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] 
+!$OMP THREADPRIVATE(ZSNOWTHRMCOND1)
+  REAL(r_std), SAVE                     :: ZSNOWTHRMCOND2 = 2.5E-6  ! [W m5/(kg2 K)] 
+!$OMP THREADPRIVATE(ZSNOWTHRMCOND2)
+  
+  ! 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) 
+!$OMP THREADPRIVATE(ZSNOWTHRMCOND_AVAP)
+  REAL(r_std), SAVE                       :: ZSNOWTHRMCOND_BVAP  = -2.5425  ! (W/m) 
+!$OMP THREADPRIVATE(ZSNOWTHRMCOND_BVAP)
+  REAL(r_std), SAVE                       :: ZSNOWTHRMCOND_CVAP  = -289.99  ! (K) 
+!$OMP THREADPRIVATE(ZSNOWTHRMCOND_CVAP)
+  
+  REAL(r_std),SAVE :: xansmax = 0.85      !! Maxmimum snow albedo
+!$OMP THREADPRIVATE(xansmax)
+  REAL(r_std),SAVE :: xansmin = 0.50      !! Miniumum snow albedo
+!$OMP THREADPRIVATE(xansmin)
+  REAL(r_std),SAVE :: xans_todry = 0.008  !! Albedo decay rate for dry snow
+!$OMP THREADPRIVATE(xans_todry)
+  REAL(r_std),SAVE :: xans_t = 0.240      !! Albedo decay rate for wet snow
+!$OMP THREADPRIVATE(xans_t)
+
+  ! 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)
+!$OMP THREADPRIVATE(ZSNOWCMPCT_RHOD)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_ACM   = 2.8e-6       !! (1/s
+!$OMP THREADPRIVATE(ZSNOWCMPCT_ACM)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_BCM   = 0.04         !! (1/K) 
+!$OMP THREADPRIVATE(ZSNOWCMPCT_BCM)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_CCM   = 460.         !! (m3/kg)
+!$OMP THREADPRIVATE(ZSNOWCMPCT_CCM)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_V0    = 3.7e7        !! (Pa/s) 
+!$OMP THREADPRIVATE(ZSNOWCMPCT_V0)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_VT    = 0.081        !! (1/K)
+!$OMP THREADPRIVATE(ZSNOWCMPCT_VT)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_VR    = 0.018        !! (m3/kg)
+!$OMP THREADPRIVATE(ZSNOWCMPCT_VR)
+
+  !
+  ! 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 = .TRUE.    !! 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 = .TRUE.       !! 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)
+
+  ! 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)
+
+  !
+  ! 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 = 20             !! Number of LAI levels (unitless)
+!$OMP THREADPRIVATE(nlai)
+  LOGICAL, SAVE :: ldq_cdrag_from_gcm = .FALSE. !! Set to .TRUE. if you want q_cdrag coming from GCM
+!$OMP THREADPRIVATE(ldq_cdrag_from_gcm)
+  REAL(r_std), SAVE :: laimax = 12.             !! Maximal LAI used for splitting LAI into N layers (m^2.m^{-2})
+!$OMP THREADPRIVATE(laimax)
+  LOGICAL, SAVE :: downregulation_co2 = .TRUE.             !! Set to .TRUE. if you want CO2 downregulation.
+!$OMP THREADPRIVATE(downregulation_co2)
+  REAL(r_std), SAVE :: downregulation_co2_baselevel = 380. !! 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, 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)
+! The default value for clay fraction is an heritage, with no documentation nor justification.   
+  REAL(r_std), SAVE :: clayfraction_default = 0.2    !! Default value for clay fraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction_default)
+! We need to output sand and silt fractiosn for SP-MIP, and the following default values, corresponding to a Loamy soil, are selected.
+  REAL(r_std), SAVE :: sandfraction_default = 0.4    !! Default value for sand fraction (0-1, unitless)
+!$OMP THREADPRIVATE(sandfraction_default)
+  REAL(r_std), SAVE :: siltfraction_default = 0.4    !! Default value for silt fraction (0-1, unitless)
+!$OMP THREADPRIVATE(siltfraction_default)
+  REAL(r_std), SAVE :: 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_struct = 0.5 !!
+!$OMP THREADPRIVATE(fire_resist_struct)
+  ! 2. Arrays
+
+  REAL(r_std), SAVE, DIMENSION(nparts) :: co2frac = &    !! The fraction of the different biomass 
+       & (/ .95, .95, 0., 0.3, 0., 0., .95, .95 /)       !! compartments emitted to the atmosphere 
+!$OMP THREADPRIVATE(co2frac)                                                         !! when burned (unitless, 0-1)  
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE, DIMENSION(3) :: bcfrac_coeff = (/ .3,  1.3,  88.2 /)         !! (unitless)
+!$OMP THREADPRIVATE(bcfrac_coeff)
+  REAL(r_std), SAVE, DIMENSION(4) :: firefrac_coeff = (/ 0.45, 0.8, 0.6, 0.13 /)  !! (unitless)
+!$OMP THREADPRIVATE(firefrac_coeff)
+
+  !
+  ! lpj_gap.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: ref_greff = 0.035         !! Asymptotic maximum mortality rate
+                                                 !! @tex $(year^{-1})$ @endtex
+!$OMP THREADPRIVATE(ref_greff)
+
+  !               
+  ! lpj_light.f90 
+  !              
+
+  ! 1. Scalar
+  
+  LOGICAL, SAVE :: annual_increase = .TRUE. !! for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or
+                                            !! to fpc of last time step (F)? (true/false)
+!$OMP THREADPRIVATE(annual_increase)
+  REAL(r_std), SAVE :: min_cover = 0.05     !! For trees, minimum fraction of crown area occupied
+                                            !! (due to its branches etc.) (0-1, unitless)
+                                            !! This means that only a small fraction of its crown area
+                                            !! can be invaded by other trees.
+!$OMP THREADPRIVATE(min_cover)
+  !
+  ! lpj_pftinout.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: min_avail = 0.01         !! minimum availability
+!$OMP THREADPRIVATE(min_avail)
+  REAL(r_std), SAVE :: ind_0 = 0.02             !! initial density of individuals
+!$OMP THREADPRIVATE(ind_0)
+  ! 3. Coefficients of equations
+  
+  REAL(r_std), SAVE :: RIP_time_min = 1.25      !! test whether the PFT has been eliminated lately (years)
+!$OMP THREADPRIVATE(RIP_time_min)
+  REAL(r_std), SAVE :: npp_longterm_init = 10.  !! Initialisation value for npp_longterm (gC.m^{-2}.year^{-1})
+!$OMP THREADPRIVATE(npp_longterm_init)
+  REAL(r_std), SAVE :: everywhere_init = 0.05   !!
+!$OMP THREADPRIVATE(everywhere_init)
+
+
+  !
+  ! stomate_alloc.f90
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: max_possible_lai = 10. !! (m^2.m^{-2})
+  REAL(r_std), PARAMETER :: Nlim_Q10 = 10.         !!
+
+  ! 1. Scalar
+
+  LOGICAL, SAVE :: ok_minres = .TRUE.              !! [DISPENSABLE] Do we try to reach a minimum reservoir even if
+                                                   !! we are severely stressed? (true/false)
+!$OMP THREADPRIVATE(ok_minres)
+  REAL(r_std), SAVE :: reserve_time_tree = 30.     !! Maximum number of days during which
+                                                   !! carbohydrate reserve may be used for 
+                                                   !! trees (days)
+!$OMP THREADPRIVATE(reserve_time_tree)
+  REAL(r_std), SAVE :: reserve_time_grass = 20.    !! Maximum number of days during which
+                                                   !! carbohydrate reserve may be used for 
+                                                   !! grasses (days)
+!$OMP THREADPRIVATE(reserve_time_grass)
+
+  REAL(r_std), SAVE :: f_fruit = 0.1               !! Default fruit allocation (0-1, unitless)
+!$OMP THREADPRIVATE(f_fruit)
+  REAL(r_std), SAVE :: alloc_sap_above_grass = 1.0 !! fraction of sapwood allocation above ground
+                                                   !! for grass (0-1, unitless)
+!$OMP THREADPRIVATE(alloc_sap_above_grass)
+  REAL(r_std), SAVE :: min_LtoLSR = 0.2            !! Prescribed lower bounds for leaf 
+                                                   !! allocation (0-1, unitless)
+!$OMP THREADPRIVATE(min_LtoLSR)
+  !! xchen liuly change 0.5 to 0.9
+  REAL(r_std), SAVE :: max_LtoLSR = 0.9            !! Prescribed upper bounds for leaf 
+                                                   !! allocation (0-1, unitless)
+!$OMP THREADPRIVATE(max_LtoLSR)
+  REAL(r_std), SAVE :: z_nitrogen = 0.2            !! Curvature of the root profile (m)
+!$OMP THREADPRIVATE(z_nitrogen)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: Nlim_tref = 25.             !! (C)
+!$OMP THREADPRIVATE(Nlim_tref)
+
+
+  !
+  ! stomate_data.f90 
+  !
+
+  ! 1. Scalar 
+
+  ! 1.1 Parameters for the pipe model
+
+  REAL(r_std), SAVE :: pipe_tune1 = 100.0        !! crown area = pipe_tune1. stem diameter**(1.6) (Reinicke's theory) (unitless)
+!$OMP THREADPRIVATE(pipe_tune1)
+  REAL(r_std), SAVE :: pipe_tune2 = 40.0         !! height=pipe_tune2 * diameter**pipe_tune3 (unitless)
+!$OMP THREADPRIVATE(pipe_tune2)
+  REAL(r_std), SAVE :: pipe_tune3 = 0.5          !! height=pipe_tune2 * diameter**pipe_tune3 (unitless)
+!$OMP THREADPRIVATE(pipe_tune3)
+  REAL(r_std), SAVE :: pipe_tune4 = 0.3          !! needed for stem diameter (unitless)
+!$OMP THREADPRIVATE(pipe_tune4)
+  REAL(r_std), SAVE :: pipe_density = 2.e5       !! Density
+!$OMP THREADPRIVATE(pipe_density)
+  REAL(r_std), SAVE :: pipe_k1 = 8.e3            !! one more SAVE
+!$OMP THREADPRIVATE(pipe_k1)
+  REAL(r_std), SAVE :: pipe_tune_exp_coeff = 1.6 !! pipe tune exponential coeff (unitless)
+!$OMP THREADPRIVATE(pipe_tune_exp_coeff)
+
+  ! 1.2 climatic parameters 
+
+  REAL(r_std), SAVE :: precip_crit = 100.        !! minimum precip, in (mm/year)
+!$OMP THREADPRIVATE(precip_crit)
+  REAL(r_std), SAVE :: gdd_crit_estab = 150.     !! minimum gdd for establishment of saplings
+!$OMP THREADPRIVATE(gdd_crit_estab)
+  REAL(r_std), SAVE :: fpc_crit = 0.95           !! critical fpc, needed for light competition and establishment (0-1, unitless)
+!$OMP THREADPRIVATE(fpc_crit)
+
+  ! 1.3 sapling characteristics
+
+  REAL(r_std), SAVE :: alpha_grass = 0.5         !! alpha coefficient for grasses (unitless)
+!$OMP THREADPRIVATE(alpha_grass)
+  REAL(r_std), SAVE :: alpha_tree = 1.           !! alpha coefficient for trees (unitless)
+!$OMP THREADPRIVATE(alpha_tree)
+  REAL(r_std), SAVE :: mass_ratio_heart_sap = 3. !! mass ratio (heartwood+sapwood)/sapwood (unitless)
+!$OMP THREADPRIVATE(mass_ratio_heart_sap)
+
+  ! 1.4  time scales for phenology and other processes (in days)
+
+  REAL(r_std), SAVE :: tau_hum_month = 20.        !! (days)       
+!$OMP THREADPRIVATE(tau_hum_month)
+  REAL(r_std), SAVE :: tau_hum_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_hum_week)
+  REAL(r_std), SAVE :: tau_t2m_month = 20.        !! (days)      
+!$OMP THREADPRIVATE(tau_t2m_month)
+  REAL(r_std), SAVE :: tau_t2m_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_t2m_week)
+  REAL(r_std), SAVE :: tau_tsoil_month = 20.      !! (days)     
+!$OMP THREADPRIVATE(tau_tsoil_month)
+  REAL(r_std), SAVE :: tau_soilhum_month = 20.    !! (days)     
+!$OMP THREADPRIVATE(tau_soilhum_month)
+  REAL(r_std), SAVE :: tau_gpp_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_gpp_week)
+  REAL(r_std), SAVE :: tau_gdd = 40.              !! (days)  
+!$OMP THREADPRIVATE(tau_gdd)
+  REAL(r_std), SAVE :: tau_ngd = 50.              !! (days)  
+!$OMP THREADPRIVATE(tau_ngd)
+  REAL(r_std), SAVE :: coeff_tau_longterm = 3.    !! (unitless)
+!$OMP THREADPRIVATE(coeff_tau_longterm)
+  REAL(r_std), SAVE :: tau_longterm_max           !! (days)  
+!$OMP THREADPRIVATE(tau_longterm_max)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: bm_sapl_carbres = 5.             !!
+!$OMP THREADPRIVATE(bm_sapl_carbres)
+  REAL(r_std), SAVE :: bm_sapl_sapabove = 0.5           !!
+!$OMP THREADPRIVATE(bm_sapl_sapabove)
+  REAL(r_std), SAVE :: bm_sapl_heartabove = 2.          !!
+!$OMP THREADPRIVATE(bm_sapl_heartabove)
+  REAL(r_std), SAVE :: bm_sapl_heartbelow = 2.          !!
+!$OMP THREADPRIVATE(bm_sapl_heartbelow)
+  REAL(r_std), SAVE :: init_sapl_mass_leaf_nat = 0.1    !!
+!$OMP THREADPRIVATE(init_sapl_mass_leaf_nat)
+  REAL(r_std), SAVE :: init_sapl_mass_leaf_agri = 1.    !!
+!$OMP THREADPRIVATE(init_sapl_mass_leaf_agri)
+  REAL(r_std), SAVE :: init_sapl_mass_carbres = 5.      !!
+!$OMP THREADPRIVATE(init_sapl_mass_carbres)
+  REAL(r_std), SAVE :: init_sapl_mass_root = 0.1        !!
+!$OMP THREADPRIVATE(init_sapl_mass_root)
+  REAL(r_std), SAVE :: init_sapl_mass_fruit = 0.3       !!  
+!$OMP THREADPRIVATE(init_sapl_mass_fruit)
+  REAL(r_std), SAVE :: cn_sapl_init = 0.5               !!
+!$OMP THREADPRIVATE(cn_sapl_init)
+  REAL(r_std), SAVE :: migrate_tree = 10.*1.E3          !!
+!$OMP THREADPRIVATE(migrate_tree)
+  REAL(r_std), SAVE :: migrate_grass = 10.*1.E3         !!
+!$OMP THREADPRIVATE(migrate_grass)
+  REAL(r_std), SAVE :: lai_initmin_tree = 0.3           !!
+!$OMP THREADPRIVATE(lai_initmin_tree)
+  REAL(r_std), SAVE :: lai_initmin_grass = 0.1          !!
+!$OMP THREADPRIVATE(lai_initmin_grass)
+  REAL(r_std), SAVE, DIMENSION(2) :: dia_coeff = (/ 4., 0.5 /)            !!
+!$OMP THREADPRIVATE(dia_coeff)
+  REAL(r_std), SAVE, DIMENSION(2) :: maxdia_coeff =(/ 100., 0.01/)        !!
+!$OMP THREADPRIVATE(maxdia_coeff)
+  REAL(r_std), SAVE, DIMENSION(4) :: bm_sapl_leaf = (/ 4., 4., 0.8, 5./)  !!
+!$OMP THREADPRIVATE(bm_sapl_leaf)
+
+
+
+  !
+  ! stomate_litter.f90 
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: Q10 = 10.               !!
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: z_decomp = 0.2               !!  Maximum depth for soil decomposer's activity (m)
+!$OMP THREADPRIVATE(z_decomp)
+
+  ! 2. Arrays
+
+  REAL(r_std), SAVE :: frac_soil_struct_aa = 0.55   !! corresponding to frac_soil(istructural,iactive,iabove) 
+!$OMP THREADPRIVATE(frac_soil_struct_aa)
+  REAL(r_std), SAVE :: frac_soil_struct_ab = 0.45   !! corresponding to frac_soil(istructural,iactive,ibelow)
+!$OMP THREADPRIVATE(frac_soil_struct_ab)
+  REAL(r_std), SAVE :: frac_soil_struct_sa = 0.7    !! corresponding to frac_soil(istructural,islow,iabove)
+!$OMP THREADPRIVATE(frac_soil_struct_sa)
+  REAL(r_std), SAVE :: frac_soil_struct_sb = 0.7    !! corresponding to frac_soil(istructural,islow,ibelow)
+!$OMP THREADPRIVATE(frac_soil_struct_sb)
+  REAL(r_std), SAVE :: frac_soil_metab_aa = 0.45    !! corresponding to frac_soil(imetabolic,iactive,iabove)
+!$OMP THREADPRIVATE(frac_soil_metab_aa)
+  REAL(r_std), SAVE :: frac_soil_metab_ab = 0.45    !! corresponding to frac_soil(imetabolic,iactive,ibelow)
+!$OMP THREADPRIVATE(frac_soil_metab_ab)
+  REAL(r_std), SAVE, DIMENSION(nparts) :: CN = &    !! C/N ratio of each plant pool (0-100, unitless)
+       & (/ 40., 40., 40., 40., 40., 40., 40., 40. /) 
+!$OMP THREADPRIVATE(CN)
+  REAL(r_std), SAVE, DIMENSION(nparts) :: LC = &    !! Lignin/C ratio of different plant parts (0,22-0,35, unitless)
+       & (/ 0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22 /)
+!$OMP THREADPRIVATE(LC)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: metabolic_ref_frac = 0.85    !! used by litter and soilcarbon (0-1, unitless)
+!$OMP THREADPRIVATE(metabolic_ref_frac)
+  REAL(r_std), SAVE :: metabolic_LN_ratio = 0.018   !! (0-1, unitless)   
+!$OMP THREADPRIVATE(metabolic_LN_ratio)
+  REAL(r_std), SAVE :: tau_metabolic = 0.066        !!
+!$OMP THREADPRIVATE(tau_metabolic)
+  REAL(r_std), SAVE :: tau_struct = 0.245           !!
+!$OMP THREADPRIVATE(tau_struct)
+  REAL(r_std), SAVE :: soil_Q10 = 0.69              !!= ln 2
+!$OMP THREADPRIVATE(soil_Q10)
+  REAL(r_std), SAVE :: 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
+
+  REAL(r_std), SAVE :: min_growthinit_time = 300.  !! minimum time since last beginning of a growing season (days)
+!$OMP THREADPRIVATE(min_growthinit_time)
+  REAL(r_std), SAVE :: moiavail_always_tree = 1.0  !! moisture monthly availability above which moisture tendency doesn't matter
+                                                   !!  - for trees (0-1, unitless)
+!$OMP THREADPRIVATE(moiavail_always_tree)
+  REAL(r_std), SAVE :: moiavail_always_grass = 0.6 !! moisture monthly availability above which moisture tendency doesn't matter
+                                                   !! - for grass (0-1, unitless)
+!$OMP THREADPRIVATE(moiavail_always_grass)
+  REAL(r_std), SAVE :: t_always                    !! monthly temp. above which temp. tendency doesn't matter
+!$OMP THREADPRIVATE(t_always)
+  REAL(r_std), SAVE :: t_always_add = 10.          !! monthly temp. above which temp. tendency doesn't matter (C)
+!$OMP THREADPRIVATE(t_always_add)
+
+  ! 3. Coefficients of equations
+  
+  REAL(r_std), SAVE :: gddncd_ref = 603.           !!
+!$OMP THREADPRIVATE(gddncd_ref)
+  REAL(r_std), SAVE :: gddncd_curve = 0.0091       !!
+!$OMP THREADPRIVATE(gddncd_curve)
+  REAL(r_std), SAVE :: gddncd_offset = 64.         !!
+!$OMP THREADPRIVATE(gddncd_offset)
+
+
+  !
+  ! stomate_prescribe.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: bm_sapl_rescale = 40.       !!
+!$OMP THREADPRIVATE(bm_sapl_rescale)
+
+
+  !
+  ! stomate_resp.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: maint_resp_min_vmax = 0.3   !!
+!$OMP THREADPRIVATE(maint_resp_min_vmax)
+  REAL(r_std), SAVE :: maint_resp_coeff = 1.4      !!
+!$OMP THREADPRIVATE(maint_resp_coeff)
+
+
+  !
+  ! stomate_soilcarbon.f90 
+  !
+
+  ! 2. Arrays 
+
+  ! 2.1 frac_carb_coefficients
+
+  REAL(r_std), SAVE :: frac_carb_ap = 0.004  !! from active pool: depends on clay content  (0-1, unitless)
+                                             !! corresponding to frac_carb(:,iactive,ipassive)
+!$OMP THREADPRIVATE(frac_carb_ap)
+  REAL(r_std), SAVE :: frac_carb_sa = 0.42   !! from slow pool (0-1, unitless)
+                                             !! corresponding to frac_carb(:,islow,iactive)
+!$OMP THREADPRIVATE(frac_carb_sa)
+  REAL(r_std), SAVE :: frac_carb_sp = 0.03   !! from slow pool (0-1, unitless) 
+                                             !! corresponding to frac_carb(:,islow,ipassive)
+!$OMP THREADPRIVATE(frac_carb_sp)
+  REAL(r_std), SAVE :: frac_carb_pa = 0.45   !! from passive pool (0-1, unitless)
+                                             !! corresponding to frac_carb(:,ipassive,iactive)
+!$OMP THREADPRIVATE(frac_carb_pa)
+  REAL(r_std), SAVE :: frac_carb_ps = 0.0    !! from passive pool (0-1, unitless)
+                                             !! corresponding to frac_carb(:,ipassive,islow)
+!$OMP THREADPRIVATE(frac_carb_ps)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: active_to_pass_clay_frac = 0.68  !! (0-1, unitless)
+!$OMP THREADPRIVATE(active_to_pass_clay_frac)
+  !! residence times in carbon pools (days)
+  REAL(r_std), SAVE :: carbon_tau_iactive = 0.149   !! residence times in active pool (days)
+!$OMP THREADPRIVATE(carbon_tau_iactive)
+  REAL(r_std), SAVE :: carbon_tau_islow = 7.0       !! residence times in slow pool (days)
+!$OMP THREADPRIVATE(carbon_tau_islow)
+  REAL(r_std), SAVE :: carbon_tau_ipassive = 300.   !! residence times in passive pool (days)
+!$OMP THREADPRIVATE(carbon_tau_ipassive)
+  REAL(r_std), SAVE, DIMENSION(3) :: flux_tot_coeff = (/ 1.2, 1.4, .75/)
+!$OMP THREADPRIVATE(flux_tot_coeff)
+
+  !
+  ! 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)
+
+    ! liulyc
+  ! parameters for turnover function of sw
+  !$OMP THREADPRIVATE(turn_sw_para1)
+  REAL(r_std), SAVE :: turn_sw_para1 = 110  !!(unitless)
+  !$OMP THREADPRIVATE(turn_sw_para2)
+  REAL(r_std), SAVE :: turn_sw_para2 = -4 !!(unitless)
+  !$OMP THREADPRIVATE(turn_sw_para3)
+  REAL(r_std), SAVE :: turn_sw_para3 = 4.5 !!(unitless)
+  !$OMP THREADPRIVATE(turn_sw_para4)
+  REAL(r_std), SAVE :: turn_sw_para4 = 1 !!(unitless)
+  !$OMP THREADPRIVATE(turn_sw_para5)
+  REAL(r_std), SAVE :: turn_sw_para5 = 1 !!(unitless)
+
+  ! parameters for turnover fraction of sw
+  !$OMP THREADPRIVATE(turn_fra_para1)
+  REAL(r_std), SAVE :: turn_fra_para1 = 0.7  !!(unitless)
+  !$OMP THREADPRIVATE(turn_fra_para2)
+  REAL(r_std), SAVE :: turn_fra_para2 = 0.9 !!(unitless)
+  !$OMP THREADPRIVATE(turn_fra_para3)
+  REAL(r_std), SAVE :: turn_fra_para3 = 1.1 !!(unitless)
+  !$OMP THREADPRIVATE(turn_fra_para4)
+  REAL(r_std), SAVE :: turn_fra_para4 = 1.3 !!(unitless)
+
+  ! parameters for alloction function of sw
+  !$OMP THREADPRIVATE(alloc_para1)
+  REAL(r_std), SAVE :: alloc_para1 = 30  !!(unitless)
+  !$OMP THREADPRIVATE(alloc_para2)
+  REAL(r_std), SAVE :: alloc_para2 = 3 !!(unitless)
+  !$OMP THREADPRIVATE(alloc_para3)
+  REAL(r_std), SAVE :: alloc_para3 = 1 !!(unitless)
+
+  
+  !! parameters for turnover scale 20220222
+  !! Note: para1 to para3 are for days > 180 while para4 to para6 for days > 180
+  !! Scale factor will be a constent 1, if set both para1 and para4 eq zero and set both para3 and para6 eq 1.
+  !$OMP THREADPRIVATE(turn_scale_para1)
+  REAL(r_std), SAVE :: turn_scale_para1 = 0  !!(unitless) 1
+  !$OMP THREADPRIVATE(turn_scale_para2)
+  REAL(r_std), SAVE :: turn_scale_para2 = 8000  !!(unitless) 8000
+  !$OMP THREADPRIVATE(turn_scale_para3)
+  REAL(r_std), SAVE :: turn_scale_para3 = 1  !!(unitless) 1.1
+
+  !$OMP THREADPRIVATE(turn_scale_para4)
+  REAL(r_std), SAVE :: turn_scale_para4 = 0 !!(unitless) 0.5
+  !$OMP THREADPRIVATE(turn_scale_para5)
+  REAL(r_std), SAVE :: turn_scale_para5 = 8000  !!(unitless) 8000 
+  !$OMP THREADPRIVATE(turn_scale_para6)
+  REAL(r_std), SAVE :: turn_scale_para6 = 1  !!(unitless) 1.1
+
+
+  
+
+  !
+  ! stomate_vmax.f90
+  !
+ 
+  ! 1. Scalar
+  !! xchen liuly changed below 3 value
+  REAL(r_std), SAVE :: vmax_offset = 0.0        !! minimum leaf efficiency (unitless)
+!$OMP THREADPRIVATE(vmax_offset)
+  REAL(r_std), SAVE :: leafage_firstmax = 0.001  !! relative leaf age at which efficiency
+                                                !! reaches 1 (unitless)
+!$OMP THREADPRIVATE(leafage_firstmax)
+  REAL(r_std), SAVE :: leafage_lastmax = 0.001    !! relative leaf age at which efficiency
+                                                !! falls below 1 (unitless)
+!$OMP THREADPRIVATE(leafage_lastmax)
+  REAL(r_std), SAVE :: leafage_old = 1.0         !! relative leaf age at which efficiency
+                                                !! reaches its minimum (vmax_offset) 
+                                                !! (unitless)
+!$OMP THREADPRIVATE(leafage_old)
+  !
+  ! stomate_season.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: gppfrac_dormance = 0.2  !! report maximal GPP/GGP_max for dormance (0-1, unitless)
+!$OMP THREADPRIVATE(gppfrac_dormance)
+  REAL(r_std), SAVE :: tau_climatology = 20.   !! tau for "climatologic variables (years)
+!$OMP THREADPRIVATE(tau_climatology)
+  REAL(r_std), SAVE :: hvc1 = 0.019            !! parameters for herbivore activity (unitless)
+!$OMP THREADPRIVATE(hvc1)
+  REAL(r_std), SAVE :: hvc2 = 1.38             !! parameters for herbivore activity (unitless)
+!$OMP THREADPRIVATE(hvc2)
+  REAL(r_std), SAVE :: leaf_frac_hvc = 0.33    !! leaf fraction (0-1, unitless)
+!$OMP THREADPRIVATE(leaf_frac_hvc)
+  REAL(r_std), SAVE :: tlong_ref_max = 303.1   !! maximum reference long term temperature (K)
+!$OMP THREADPRIVATE(tlong_ref_max)
+  REAL(r_std), SAVE :: tlong_ref_min = 253.1   !! minimum reference long term temperature (K)
+!$OMP THREADPRIVATE(tlong_ref_min)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: ncd_max_year = 3.
+!$OMP THREADPRIVATE(ncd_max_year)
+  REAL(r_std), SAVE :: gdd_threshold = 5.
+!$OMP THREADPRIVATE(gdd_threshold)
+  REAL(r_std), SAVE :: green_age_ever = 2.
+!$OMP THREADPRIVATE(green_age_ever)
+  REAL(r_std), SAVE :: green_age_dec = 0.5
+!$OMP THREADPRIVATE(green_age_dec)
+
+END MODULE constantes_var
Index: /branches/publications/ORCHIDEE-AFP/src_parameters/control.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/control.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/control.f90	(revision 8430)
@@ -0,0 +1,436 @@
+! =================================================================================================================================
+! MODULE       : control
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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
+
+    IMPLICIT NONE
+    
+    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
+    ! Start reading options from parameter file 
+
+    !Config Key   = SOILTYPE_CLASSIF
+    !Config Desc  = Type of classification used for the map of soil types 
+    !Config Def   = zobler
+    !Config If    = !IMPOSE_VEG
+    !Config Help  = The classification used in the file that we use here 
+    !Config         There are three classification supported:  
+    !Config         Zobler (7 converted to 3) and USDA (12) 
+    !Config Units = [-]
+    !
+    !-tdo- Suivant le type de classification utilisee pour le sol, on adapte nscm 
+    soil_classif = 'zobler'
+    CALL getin_p('SOILTYPE_CLASSIF',soil_classif)
+    SELECTCASE (soil_classif)
+    CASE ('zobler','none')
+       nscm = nscm_fao
+    CASE ('usda')
+       nscm = nscm_usda
+    CASE DEFAULT
+       WRITE(numout,*) "Unsupported soil type classification: soil_classif=",soil_classif
+       WRITE(numout,*) "Choose between zobler, usda and none according to the map"
+       CALL ipslerr_p(3,'control_initialize','Bad choice of soil_classif','Choose between zobler, usda and none','')
+    ENDSELECT
+
+
+    !Config Key   = RIVER_ROUTING
+    !Config Desc  = Decides if we route the water or not
+    !Config If    = OK_SECHIBA
+    !Config Def   = y
+    !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 = .TRUE.
+    CALL getin_p('RIVER_ROUTING', river_routing)
+    IF (printlev>=1) 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_p(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_p(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   = y
+    !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_p(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   = DO_WOOD_HARVEST
+    !Config Desc  = Activate Wood Harvest ?
+    !Config If    = OK_STOMATE
+    !Config Def   = y
+    !Config Help  = set to TRUE if wood is harvested
+    !Config Units = [FLAG]
+    do_wood_harvest = .TRUE.
+    CALL getin_p('DO_WOOD_HARVEST',do_wood_harvest)
+
+    !
+    !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)
+    IF (printlev>=1) WRITE(numout,*) 'Biogenic emissions: ', ok_bvoc
+
+    IF ( ok_bvoc ) THEN 
+       ok_leafage         = .TRUE. 
+       ok_radcanopy       = .TRUE. 
+       ok_multilayer      = .TRUE.
+       ok_pulse_NOx       = .TRUE.
+       ok_bbgfertil_NOx   = .TRUE.
+       ok_cropsfertil_NOx = .TRUE.
+    ELSE
+       ok_leafage         = .FALSE. 
+       ok_radcanopy       = .FALSE. 
+       ok_multilayer      = .FALSE.
+       ok_pulse_NOx       = .FALSE.
+       ok_bbgfertil_NOx   = .FALSE.
+       ok_cropsfertil_NOx = .FALSE.
+    ENDIF
+    !
+    !Config Key   = CHEMISTRY_LEAFAGE
+    !Config Desc  = Activate LEAFAGE?
+    !Config If    = CHEMISTRY_BVOC
+    !Config Def   = n
+    !Config Help  = set to TRUE if biogenic emissions calculation takes leaf age into account
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('CHEMISTRY_LEAFAGE', ok_leafage)
+    IF (printlev>=1) 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)
+    IF (printlev>=1) WRITE(numout,*) 'Canopy radiative transfer model: ', ok_radcanopy
+    !
+    !Config Key   = CANOPY_MULTILAYER
+    !Config Desc  = Use canopy radiative transfer model with multi-layers
+    !Config If    = CANOPY_EXTINCTION 
+    !Config Def   = n
+    !Config Help  = set to TRUE if canopy radiative transfer model is with multiple layers 
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('CANOPY_MULTILAYER', ok_multilayer)
+    IF (printlev>=1) 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)
+    IF (printlev>=1) 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)
+    IF (printlev>=1) 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)
+    IF (printlev>=1) 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)
+    IF (printlev>=1) WRITE(numout,*) '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)
+    IF (printlev>=1) WRITE(numout,*) 'CO2 impact on BVOC - Wilkinson parameterisation: ', ok_co2bvoc_wilk
+    
+    !
+    ! control initialisation with sechiba
+    !
+    ok_sechiba = .TRUE.
+    !
+    !
+    ! Ensure consistency
+    !
+    IF ( ok_dgvm ) ok_stomate = .TRUE.
+    IF ( ok_multilayer .AND. .NOT.(ok_radcanopy) ) THEN
+       ok_radcanopy  = .TRUE.
+       IF (printlev>=1) WRITE(numout,*) 'You want to use the multilayer model without activating the flag CANOPY_EXTINCTION'
+       IF (printlev>=1) WRITE(numout,*) 'We set CANOPY_EXTINCTION to TRUE to ensure consistency'
+    ENDIF
+
+
+
+    !
+    ! Here we need the same initialisation as above
+    !
+    ok_pheno = .TRUE.
+
+    !
+    ! Configuration : number of PFTs and parameters
+    !
+
+    ! 1. Number of PFTs defined by the user
+
+    !Config Key   = NVM
+    !Config Desc  = number of PFTs  
+    !Config If    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = 13
+    !Config Help  = The number of vegetation types define by the user
+    !Config Units = [-]
+    !
+    CALL getin_p('NVM',nvm)
+    IF (printlev>=1) 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
+    !! Case CWRR : 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_p(3,'control_initialize','Too shallow soil chosen for the thermodynamic for soil freezing', &
+            'Adapt run.def with at least DEPTH_MAX=11','')
+    END IF
+        
+    ! Define diaglev as the depth of the bottom of each layer 
+    ! diaglev defines the vertical axes for the variables transmitted from sechiba 
+    ! to stomate (stempdiag, shumdiag).
+    ALLOCATE(diaglev(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'control_initialize','Pb in allocation of diaglev','','')
+
+    ! Get diaglev from module vertical for CWRR
+    ! 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. 
+    diaglev=zlt(1:nslm)
+    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 and config_stomate_pft_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-AFP/src_parameters/pft_parameters.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/pft_parameters.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/pft_parameters.f90	(revision 8430)
@@ -0,0 +1,3442 @@
+! =================================================================================================================================
+! MODULE       : pft_parameters
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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,...) 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   = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+       !Config Help  =
+       !Config Units = [-]
+       CALL getin_p('PFT_TO_MTC',pft_to_mtc)
+
+       !! 3.3 If the user want to use the standard configuration, he needn't to fill the correspondance array
+       !!     If the configuration is wrong, send a error message to the user.
+       IF(nvm /= nvmc ) THEN
+          !
+          IF(pft_to_mtc(1) == undef_int) THEN
+             STOP ' The array PFT_TO_MTC is empty : we stop'
+          ENDIF !(pft_to_mtc(1) == undef_int)
+          !
+       ENDIF !(nvm /= nvmc )
+
+       !! 3.4 Some error messages
+
+       !! 3.4.1 What happened if pft_to_mtc(j) > nvmc or pft_to_mtc(j) <=0 (if the mtc doesn't exist)?
+       DO j = 1, nvm ! Loop over # PFTs  
+          !
+          IF( (pft_to_mtc(j) > nvmc) .OR. (pft_to_mtc(j) <= 0) ) THEN
+             WRITE(numout,*) 'the metaclass chosen does not exist'
+             STOP 'we stop reading pft_to_mtc'
+          ENDIF !( (pft_to_mtc(j) > nvmc) .OR. (pft_to_mtc(j) <= 0) )
+          !
+       ENDDO  ! Loop over # PFTs  
+
+
+       !! 3.4.2 Check if pft_to_mtc(1) = 1 
+       IF(pft_to_mtc(1) /= 1) THEN
+          !
+          WRITE(numout,*) 'the first pft has to be the bare soil'
+          STOP 'we stop reading next values of pft_to_mtc'
+          !
+       ELSE
+          !
+          DO j = 2,nvm ! Loop over # PFTs different from bare soil
+             !
+             IF(pft_to_mtc(j) == 1) THEN
+                WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil'
+                STOP 'we stop reading pft_to_mtc'
+             ENDIF ! (pft_to_mtc(j) == 1)
+             !
+          ENDDO ! Loop over # PFTs different from bare soil
+          !
+       ENDIF !(pft_to_mtc(1) /= 1)
+
+
+       !! 4.Initialisation of the pfts-parameters
+       CALL pft_parameters_init()
+
+       !! 5. Useful data
+
+       !! 5.1 Read the name of the PFTs given by the user
+       !
+       !Config Key   = PFT_NAME
+       !Config Desc  = Name of a PFT
+       !Config if    = OK_SECHIBA or OK_STOMATE
+       !Config Def   = bare ground, tropical broad-leaved evergreen, tropical broad-leaved raingreen, 
+       !Config         temperate needleleaf evergreen, temperate broad-leaved evergreen temperate broad-leaved summergreen,
+       !Config         boreal needleleaf evergreen, boreal broad-leaved summergreen, boreal needleleaf summergreen,
+       !Config         C3 grass, C4 grass, C3 agriculture, C4 agriculture    
+       !Config Help  = the user can name the new PFTs he/she introducing for new species
+       !Config Units = [-]
+       CALL getin_p('PFT_NAME',pft_name)
+
+       !! 5.2 A useful message to the user: correspondance between the number of the pft
+       !! and the name of the associated mtc 
+       IF (printlev >=1 ) THEN
+          WRITE(numout,*) ''
+          DO j = 2,nvm ! Loop over # PFTs
+             WRITE(numout,*) 'The PFT',j, 'called ', trim(PFT_name(j)),' corresponds to the MTC : ',trim(MTC_name(pft_to_mtc(j)))
+          END DO
+          WRITE(numout,*) ''
+       END IF
+
+
+       !! 6. End message
+       IF (printlev>=3) WRITE(numout,*) 'pft_parameters_done'
+
+       !! 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,...).\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
+       IF (printlev>=2) 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
+       IF (printlev>=2) WRITE(numout,*)'Initialize humcst using reference values for 4m soil depth'
+       humcste(:) = humcste_ref4m(pft_to_mtc(:))  ! values for 4m soil depth 
+    ELSE
+       IF (printlev>=2) WRITE(numout,*)'Note that humcste is initialized with values for 2m soil depth bur zmaxh=', zmaxh
+       humcste(:) = humcste_ref2m(pft_to_mtc(:))  ! values for 2m soil depth
+    END IF
+    !
+    ! Soil - vegetation
+    !
+    pref_soil_veg(:) = pref_soil_veg_mtc(pft_to_mtc(:))
+    !
+    ! Photosynthesis
+    !
+    is_c4(:) = is_c4_mtc(pft_to_mtc(:))
+    vcmax_fix(:) = vcmax_fix_mtc(pft_to_mtc(:))
+    downregulation_co2_coeff(:) = downregulation_co2_coeff_mtc(pft_to_mtc(:))
+    E_KmC(:)      = E_KmC_mtc(pft_to_mtc(:))
+    E_KmO(:)      = E_KmO_mtc(pft_to_mtc(:))
+    E_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(:))
+    !
+    !! Define labels from physiologic characteristics 
+    !
+    leaf_tab(:) = leaf_tab_mtc(pft_to_mtc(:)) 
+    pheno_model(:) = pheno_model_mtc(pft_to_mtc(:))   
+    !
+    is_tree(:) = .FALSE.
+    DO jv = 1,nvm
+       IF ( leaf_tab(jv) <= 2 ) is_tree(jv) = .TRUE.
+    END DO
+    !
+    is_deciduous(:) = .FALSE.
+    DO jv = 1,nvm
+       IF ( is_tree(jv) .AND. (pheno_model(jv) /= "none") ) is_deciduous(jv) = .TRUE.
+    END DO
+    !
+    is_evergreen(:) = .FALSE.
+    DO jv = 1,nvm
+       IF ( is_tree(jv) .AND. (pheno_model(jv) == "none") ) is_evergreen(jv) = .TRUE.
+    END DO
+    !
+    is_needleleaf(:) = .FALSE.
+    DO jv = 1,nvm
+       IF ( leaf_tab(jv) == 2 ) is_needleleaf(jv) = .TRUE.
+    END DO
+
+
+    ! 1.2 For sechiba parameters
+
+    IF (ok_sechiba) THEN
+       !
+       ! Vegetation structure - sechiba
+       !
+       rveg_pft(:) = rveg_mtc(pft_to_mtc(:))
+       !
+       ! Evapotranspiration -  sechiba
+       !
+       rstruct_const(:) = rstruct_const_mtc(pft_to_mtc(:))
+       kzero(:) = kzero_mtc(pft_to_mtc(:))
+       !
+       ! Water - sechiba
+       !
+       wmax_veg(:) = wmax_veg_mtc(pft_to_mtc(:))
+       IF ( OFF_LINE_MODE ) THEN
+          throughfall_by_pft(:) = 0.
+       ELSE
+          throughfall_by_pft(:) = throughfall_by_mtc(pft_to_mtc(:))
+       ENDIF
+       !
+       ! Albedo - sechiba
+       !
+       snowa_aged_vis(:) = snowa_aged_vis_mtc(pft_to_mtc(:))
+       snowa_aged_nir(:) = snowa_aged_nir_mtc(pft_to_mtc(:))
+       snowa_dec_vis(:) = snowa_dec_vis_mtc(pft_to_mtc(:)) 
+       snowa_dec_nir(:) = snowa_dec_nir_mtc(pft_to_mtc(:)) 
+       alb_leaf_vis(:) = alb_leaf_vis_mtc(pft_to_mtc(:))  
+       alb_leaf_nir(:) = alb_leaf_nir_mtc(pft_to_mtc(:))
+       !-
+    ENDIF !(ok_sechiba)
+
+    ! 1.3 For BVOC parameters
+
+    IF (ok_bvoc) THEN
+       !
+       ! Biogenic Volatile Organic Compounds
+       !
+       em_factor_isoprene(:) = em_factor_isoprene_mtc(pft_to_mtc(:))
+       em_factor_monoterpene(:) = em_factor_monoterpene_mtc(pft_to_mtc(:))
+       LDF_mono = LDF_mono_mtc 
+       LDF_sesq = LDF_sesq_mtc 
+       LDF_meth = LDF_meth_mtc 
+       LDF_acet = LDF_acet_mtc 
+
+       em_factor_apinene(:) = em_factor_apinene_mtc(pft_to_mtc(:))
+       em_factor_bpinene(:) = em_factor_bpinene_mtc(pft_to_mtc(:))
+       em_factor_limonene(:) = em_factor_limonene_mtc(pft_to_mtc(:))
+       em_factor_myrcene(:) = em_factor_myrcene_mtc(pft_to_mtc(:))
+       em_factor_sabinene(:) = em_factor_sabinene_mtc(pft_to_mtc(:))
+       em_factor_camphene(:) = em_factor_camphene_mtc(pft_to_mtc(:))
+       em_factor_3carene(:) = em_factor_3carene_mtc(pft_to_mtc(:))
+       em_factor_tbocimene(:) = em_factor_tbocimene_mtc(pft_to_mtc(:))
+       em_factor_othermonot(:) = em_factor_othermonot_mtc(pft_to_mtc(:))
+       em_factor_sesquiterp(:) = em_factor_sesquiterp_mtc(pft_to_mtc(:))
+
+       beta_mono = beta_mono_mtc
+       beta_sesq = beta_sesq_mtc
+       beta_meth = beta_meth_mtc
+       beta_acet = beta_acet_mtc
+       beta_oxyVOC = beta_oxyVOC_mtc
+
+       em_factor_ORVOC(:) = em_factor_ORVOC_mtc(pft_to_mtc(:)) 
+       em_factor_OVOC(:) = em_factor_OVOC_mtc(pft_to_mtc(:))
+       em_factor_MBO(:) = em_factor_MBO_mtc(pft_to_mtc(:))
+       em_factor_methanol(:) = em_factor_methanol_mtc(pft_to_mtc(:))
+       em_factor_acetone(:) = em_factor_acetone_mtc(pft_to_mtc(:)) 
+       em_factor_acetal(:) = em_factor_acetal_mtc(pft_to_mtc(:))
+       em_factor_formal(:) = em_factor_formal_mtc(pft_to_mtc(:))
+       em_factor_acetic(:) = em_factor_acetic_mtc(pft_to_mtc(:))
+       em_factor_formic(:) = em_factor_formic_mtc(pft_to_mtc(:))
+       em_factor_no_wet(:) = em_factor_no_wet_mtc(pft_to_mtc(:))
+       em_factor_no_dry(:) = em_factor_no_dry_mtc(pft_to_mtc(:))
+       Larch(:) = Larch_mtc(pft_to_mtc(:)) 
+       !-
+    ENDIF !(ok_bvoc)
+
+    ! 1.4 For stomate parameters
+
+    IF (ok_stomate) THEN
+       !
+       ! Vegetation structure - stomate
+       !
+       sla(:) = sla_mtc(pft_to_mtc(:))
+       availability_fact(:) = availability_fact_mtc(pft_to_mtc(:))
+       !
+       ! Allocation - stomate
+       !
+       R0(:) = R0_mtc(pft_to_mtc(:)) 
+       S0(:) = S0_mtc(pft_to_mtc(:)) 
+       !
+       ! Respiration - stomate
+       !
+       frac_growthresp(:) = frac_growthresp_mtc(pft_to_mtc(:))  
+       maint_resp_slope_c(:) = maint_resp_slope_c_mtc(pft_to_mtc(:))               
+       maint_resp_slope_b(:) = maint_resp_slope_b_mtc(pft_to_mtc(:))
+       maint_resp_slope_a(:) = maint_resp_slope_a_mtc(pft_to_mtc(:))
+       cm_zero_leaf(:) = cm_zero_leaf_mtc(pft_to_mtc(:))
+       cm_zero_sapabove(:) = cm_zero_sapabove_mtc(pft_to_mtc(:))
+       cm_zero_sapbelow(:) = cm_zero_sapbelow_mtc(pft_to_mtc(:)) 
+       cm_zero_heartabove(:) = cm_zero_heartabove_mtc(pft_to_mtc(:)) 
+       cm_zero_heartbelow(:) = cm_zero_heartbelow_mtc(pft_to_mtc(:))
+       cm_zero_root(:) = cm_zero_root_mtc(pft_to_mtc(:))
+       cm_zero_fruit(:) = cm_zero_fruit_mtc(pft_to_mtc(:))
+       cm_zero_carbres(:) = cm_zero_carbres_mtc(pft_to_mtc(:))
+       !
+       ! Fire - stomate
+       !
+       flam(:) = flam_mtc(pft_to_mtc(:))
+       resist(:) = resist_mtc(pft_to_mtc(:))
+       !
+       ! Flux - LUC
+       !
+       coeff_lcchange_1(:) = coeff_lcchange_1_mtc(pft_to_mtc(:))
+       coeff_lcchange_10(:) = coeff_lcchange_10_mtc(pft_to_mtc(:))
+       coeff_lcchange_100(:) = coeff_lcchange_100_mtc(pft_to_mtc(:))
+       !
+       ! Phenology
+       !
+       !
+       ! 1. Stomate
+       !
+       lai_max_to_happy(:) = lai_max_to_happy_mtc(pft_to_mtc(:))  
+       lai_max(:) = lai_max_mtc(pft_to_mtc(:))
+       pheno_type(:) = pheno_type_mtc(pft_to_mtc(:))
+       !
+       ! 2. Leaf Onset
+       !
+       pheno_gdd_crit_c(:) = pheno_gdd_crit_c_mtc(pft_to_mtc(:))
+       pheno_gdd_crit_b(:) = pheno_gdd_crit_b_mtc(pft_to_mtc(:))         
+       pheno_gdd_crit_a(:) = pheno_gdd_crit_a_mtc(pft_to_mtc(:))
+       pheno_moigdd_t_crit(:) = pheno_moigdd_t_crit_mtc(pft_to_mtc(:))
+       ngd_crit(:) =  ngd_crit_mtc(pft_to_mtc(:))
+       ncdgdd_temp(:) = ncdgdd_temp_mtc(pft_to_mtc(:)) 
+       hum_frac(:) = hum_frac_mtc(pft_to_mtc(:))
+       hum_min_time(:) = hum_min_time_mtc(pft_to_mtc(:))
+       tau_sap(:) = tau_sap_mtc(pft_to_mtc(:))
+       tau_leafinit(:) = tau_leafinit_mtc(pft_to_mtc(:))  
+       tau_fruit(:) = tau_fruit_mtc(pft_to_mtc(:))
+       ecureuil(:) = ecureuil_mtc(pft_to_mtc(:))
+       alloc_min(:) = alloc_min_mtc(pft_to_mtc(:))
+       alloc_max(:) = alloc_max_mtc(pft_to_mtc(:))
+       demi_alloc(:) = demi_alloc_mtc(pft_to_mtc(:))
+       leaflife_tab(:) = leaflife_mtc(pft_to_mtc(:))
+       !
+       ! 3. Senescence
+       !
+       leaffall(:) = leaffall_mtc(pft_to_mtc(:))
+       leafagecrit(:) = leafagecrit_mtc(pft_to_mtc(:))
+       senescence_type(:) = senescence_type_mtc(pft_to_mtc(:)) 
+       senescence_hum(:) = senescence_hum_mtc(pft_to_mtc(:)) 
+       nosenescence_hum(:) = nosenescence_hum_mtc(pft_to_mtc(:)) 
+       max_turnover_time(:) = max_turnover_time_mtc(pft_to_mtc(:))
+       min_turnover_time(:) = min_turnover_time_mtc(pft_to_mtc(:))
+       min_leaf_age_for_senescence(:) = min_leaf_age_for_senescence_mtc(pft_to_mtc(:))
+       senescence_temp_c(:) = senescence_temp_c_mtc(pft_to_mtc(:))
+       senescence_temp_b(:) = senescence_temp_b_mtc(pft_to_mtc(:))
+       senescence_temp_a(:) = senescence_temp_a_mtc(pft_to_mtc(:))
+       gdd_senescence(:) = gdd_senescence_mtc(pft_to_mtc(:))
+       always_init(:) = always_init_mtc(pft_to_mtc(:))
+       !
+       ! DGVM
+       !
+       residence_time(:) = residence_time_mtc(pft_to_mtc(:))
+       tmin_crit(:) = tmin_crit_mtc(pft_to_mtc(:))
+       tcm_crit(:) = tcm_crit_mtc(pft_to_mtc(:))
+       !-
+    ENDIF !(ok_stomate)
+
+  END SUBROUTINE pft_parameters_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_alloc
+!!
+!>\BRIEF         This subroutine allocates memory needed for the PFT parameters 
+!! in function  of the flags activated.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pft_parameters_alloc()
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.1 Input variables 
+
+    !! 0.4 Local variables
+
+    LOGICAL :: l_error                             !! Diagnostic boolean for error allocation (true/false) 
+    INTEGER :: ier                                 !! Return value for memory allocation (0-N, unitless)
+
+    !_ ================================================================================================================================
+
+
+    !
+    ! 1. Parameters used anytime
+    !
+
+    l_error = .FALSE.
+
+    ALLOCATE(pft_to_mtc(nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for pft_to_mtc. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+    ALLOCATE(PFT_name(nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for PFT_name. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+    ALLOCATE(height_presc(nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for height_presc. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+    ALLOCATE(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(leaf_tab(nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for leaf_tab. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+    ALLOCATE(pheno_model(nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for pheno_model. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+    ALLOCATE(is_deciduous(nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for is_deciduous. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+    ALLOCATE(is_evergreen(nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for is_evergreen. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+    ALLOCATE(is_needleleaf(nvm),stat=ier)  
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for is_needleleaf. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+    ALLOCATE(is_tropical(nvm),stat=ier)   
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) ' Memory allocation error for is_tropical. We stop. We need nvm words = ',nvm
+       STOP 'pft_parameters_alloc'
+    END IF
+
+
+    !
+    ! 2. Parameters used if ok_sechiba only
+    !
+    IF ( ok_sechiba ) THEN
+
+       l_error = .FALSE.
+
+       ALLOCATE(rstruct_const(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for rstruct_const. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(kzero(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for kzero. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(rveg_pft(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for rveg_pft. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(wmax_veg(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for wmax_veg. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(throughfall_by_pft(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for throughfall_by_pft. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(snowa_aged_vis(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for snowa_aged_vis. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(snowa_aged_nir(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for snowa_aged_nir. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(snowa_dec_vis(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(snowa_dec_nir(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for snowa_dec_nir. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(alb_leaf_vis(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for alb_leaf_vis. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(alb_leaf_nir(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for alb_leaf_nir. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       IF( ok_bvoc ) THEN
+
+          l_error = .FALSE.
+
+          ALLOCATE(em_factor_isoprene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_isoprene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_monoterpene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_monoterpene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_apinene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_apinene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_bpinene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_bpinene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_limonene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_limonene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_myrcene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_myrcene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_sabinene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_sabinene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_camphene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_camphene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_3carene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_3carene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_tbocimene(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_tbocimene. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_othermonot(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_othermonot. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_sesquiterp(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_sesquiterp. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+
+          ALLOCATE(em_factor_ORVOC(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_ORVOC. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_OVOC(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0)       
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_OVOC. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_MBO(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_MBO. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_methanol(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_methanol. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_acetone(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_acetone. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_acetal(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_acetal. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_formal(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_formal. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_acetic(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0)       
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_acetic. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_formic(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_formic. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_no_wet(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0)
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_no_wet. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(em_factor_no_dry(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0)       
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for em_factor_no_dry. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+          ALLOCATE(Larch(nvm),stat=ier)
+          l_error = l_error .OR. (ier /= 0) 
+          IF (l_error) THEN
+             WRITE(numout,*) ' Memory allocation error for Larch. We stop. We need nvm words = ',nvm
+             STOP 'pft_parameters_alloc'
+          END IF
+
+       ENDIF ! (ok_bvoc) 
+
+    ENDIF !(ok_sechiba)
+
+    !
+    ! 3. Parameters used if ok_stomate only
+    !
+    IF ( ok_stomate ) THEN
+
+       l_error = .FALSE.
+
+       ALLOCATE(sla(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for sla. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(availability_fact(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for availability_fact. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(R0(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for R0. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(S0(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for S0. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(L0(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for L0. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(pheno_gdd_crit_c(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_c. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(pheno_gdd_crit_b(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_b. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(pheno_gdd_crit_a(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_a. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(pheno_gdd_crit(nvm,3),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit. We stop. We need nvm words = ',nvm*3
+          STOP 'pft_parameters_alloc'
+       END IF
+       pheno_gdd_crit(:,:) = zero
+
+       ALLOCATE(pheno_moigdd_t_crit(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for pheno_moigdd_t_crit. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(ngd_crit(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for ngd_crit. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(ncdgdd_temp(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for ncdgdd_temp. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(hum_frac(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for hum_frac. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(hum_min_time(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for hum_min_time. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(tau_sap(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for tau_sap. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(tau_leafinit(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for tau_leafinit. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(tau_fruit(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for tau_fruit. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(ecureuil(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for ecureuil. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(alloc_min(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for alloc_min. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(alloc_max(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for alloc_max. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(demi_alloc(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(frac_growthresp(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for frac_growthresp. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(maint_resp_slope(nvm,3),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for maint_resp_slope. We stop. We need nvm*3 words = ',nvm*3
+          STOP 'pft_parameters_alloc'
+       END IF
+       maint_resp_slope(:,:) = zero
+
+       ALLOCATE(maint_resp_slope_c(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for maint_resp_slope_c. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(maint_resp_slope_b(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for maint_resp_slope_b. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(maint_resp_slope_a(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for maint_resp_slope_a. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(coeff_maint_zero(nvm,nparts),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for coeff_maint_zero. We stop. We need nvm*nparts words = ',nvm*nparts
+          STOP 'pft_parameters_alloc'
+       END IF
+       coeff_maint_zero(:,:) = zero
+
+       ALLOCATE(cm_zero_leaf(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cm_zero_leaf. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(cm_zero_sapabove(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cm_zero_sapabove. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(cm_zero_sapbelow(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cm_zero_sapbelow. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(cm_zero_heartabove(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cm_zero_heartabove. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(cm_zero_heartbelow(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cm_zero_heartbelow. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(cm_zero_root(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cm_zero_root. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(cm_zero_fruit(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cm_zero_fruit. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(cm_zero_carbres(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cm_zero_carbres. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(flam(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(resist(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for resist. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(coeff_lcchange_1(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for coeff_lcchange_1. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(coeff_lcchange_10(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for coeff_lcchange_10. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(coeff_lcchange_100(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for coeff_lcchange_100. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(lai_max_to_happy(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for lai_max_to_happy. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(lai_max(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for lai_max. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(pheno_type(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for pheno_type. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(leaffall(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for leaffall. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(leafagecrit(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for leafagecrit. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(senescence_type(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(senescence_hum(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for senescence_hum. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(nosenescence_hum(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for nosenescence_hum. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(max_turnover_time(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for max_turnover_time. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(min_turnover_time(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for min_turnover_time. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(min_leaf_age_for_senescence(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for min_leaf_age_for_senescence. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(senescence_temp_c(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for senescence_temp_c. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(senescence_temp_b(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for senescence_temp_b. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(senescence_temp_a(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for senescence_temp_a. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(senescence_temp(nvm,3),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for senescence_temp. We stop. We need nvm*3 words = ',nvm*3
+          STOP 'pft_parameters_alloc'
+       END IF
+       senescence_temp(:,:) = zero
+
+       ALLOCATE(gdd_senescence(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for gdd_senescence. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(always_init(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for always_init. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(residence_time(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for residence_time. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(tmin_crit(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for tmin_crit. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(tcm_crit(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for tcm_crit. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(lai_initmin(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(bm_sapl(nvm,nparts,nelements),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for bm_sapl. We stop. We need nvm*nparts*nelements words = ',& 
+               &  nvm*nparts*nelements
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(migrate(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for migrate. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(maxdia(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for maxdia. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(cn_sapl(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for cn_sapl. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(leaf_timecst(nvm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for leaf_timecst. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+       ALLOCATE(leaflife_tab(nvm),stat=ier)   
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) ' Memory allocation error for leaflife_tab. We stop. We need nvm words = ',nvm
+          STOP 'pft_parameters_alloc'
+       END IF
+
+    ENDIF ! (ok_stomate)
+
+  END SUBROUTINE pft_parameters_alloc
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_pft_parameters 
+!!
+!>\BRIEF          This subroutine will read the imposed values for the global pft
+!! parameters (sechiba + stomate). It is not called if IMPOSE_PARAM is set to NO.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_pft_parameters
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variable
+
+    INTEGER(i_std) :: jv                   !! 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, 45.0, 45.0, 35.0, 40.0, 50.0, 45.0, 35.0, 35.0, 50.0, 50.0, 60.0, 60.0
+    !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   = 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.
+    !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   = 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.
+    !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)
+
+  END SUBROUTINE config_pft_parameters
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_sechiba_pft_parameters
+!!
+!>\BRIEF        This subroutine will read the imposed values for the sechiba pft
+!! parameters. It is not called if IMPOSE_PARAM is set to NO. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_sechiba_pft_parameters()
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+
+    !! 0.1 Input variables
+
+    !! 0.4 Local variable
+
+    !_ ================================================================================================================================ 
+
+    !
+    ! 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_VIS
+    !Config Desc  = Minimum snow albedo value for each vegetation type after aging (dirty old snow), visible albedo
+    !Config if    = OK_SECHIBA
+    !Config Def   = 0.74, 0.0, 0.0, 0.08, 0.24, 0.07, 0.18, 0.18, 0.33, 0.57, 0.57, 0.57, 0.57
+    !Config Help  = Values optimized for ORCHIDEE2.0
+    !Config Units = [-]
+    CALL getin_p('SNOWA_AGED_VIS',snowa_aged_vis)
+
+    !Config Key   = SNOWA_AGED_NIR
+    !Config Desc  = Minimum snow albedo value for each vegetation type after aging (dirty old snow), near infrared albedo
+    !Config if    = OK_SECHIBA
+    !Config Def   = 0.50, 0.0, 0.0, 0.10, 0.37, 0.08, 0.16, 0.17, 0.27, 0.44, 0.44, 0.44, 0.44  
+    !Config Help  = Values optimized for ORCHIDEE2.0
+    !Config Units = [-]
+    CALL getin_p('SNOWA_AGED_NIR',snowa_aged_nir)
+
+    !Config Key   = SNOWA_DEC_VIS
+    !Config Desc  = Decay rate of snow albedo value for each vegetation type as it will be used in condveg_snow, visible albedo
+    !Config if    = OK_SECHIBA
+    !Config Def   = 0.21, 0.0, 0.0, 0.14, 0.08, 0.17, 0.05, 0.06, 0.09, 0.15, 0.15, 0.15, 0.15 
+    !Config Help  = Values optimized for ORCHIDEE2.0
+    !Config Units = [-]
+    CALL getin_p('SNOWA_DEC_VIS',snowa_dec_vis)
+
+    !Config Key   = SNOWA_DEC_NIR
+    !Config Desc  = Decay rate of snow albedo value for each vegetation type as it will be used in condveg_snow, near infrared albedo
+    !Config if    = OK_SECHIBA
+    !Config Def   = 0.13, 0.0, 0.0, 0.10, 0.10, 0.16, 0.04, 0.07, 0.08, 0.12, 0.12, 0.12, 0.12
+    !Config Help  = Values optimized for ORCHIDEE2.0
+    !Config Units = [-]
+    CALL getin_p('SNOWA_DEC_NIR',snowa_dec_nir)
+
+    !Config Key   = ALB_LEAF_VIS
+    !Config Desc  = leaf albedo of vegetation type, visible albedo
+    !Config if    = OK_SECHIBA
+    !Config Def   = 0.00, 0.04, 0.04, 0.04, 0.04, 0.03, 0.03, 0.03, 0.03, 0.06, 0.06, 0.06, 0.06
+    !Config Help  = Values optimized for ORCHIDEE2.0
+    !Config Units = [-]
+    CALL getin_p('ALB_LEAF_VIS',alb_leaf_vis)
+
+    !Config Key   = ALB_LEAF_NIR
+    !Config Desc  = leaf albedo of vegetation type, near infrared albedo
+    !Config if    = OK_SECHIBA
+    !Config Def   = 0.00, 0.23, 0.18, 0.18, 0.20, 0.24, 0.15, 0.26, 0.20, 0.24, 0.27, 0.28, 0.26
+    !Config Help  = Values optimized for ORCHIDEE2.0
+    !Config Units = [-]
+    CALL getin_p('ALB_LEAF_NIR',alb_leaf_nir)
+
+    IF ( ok_bvoc ) THEN
+       !
+       ! BVOC
+       !
+
+       !Config Key   = ISO_ACTIVITY
+       !Config Desc  = Biogenic activity for each age class : isoprene
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.5, 1.5, 1.5, 0.5
+       !Config Help  =
+       !Config Units = [-]
+       CALL getin_p('ISO_ACTIVITY',iso_activity)
+
+       !Config Key   = METHANOL_ACTIVITY
+       !Config Desc  = Isoprene emission factor for each age class : methanol
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 1., 1., 0.5, 0.5
+       !Config Help  =
+       !Config Units = [-]
+       CALL getin_p('METHANOL_ACTIVITY',methanol_activity)
+
+       !Config Key   = EM_FACTOR_ISOPRENE
+       !Config Desc  = Isoprene emission factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 24., 24., 8., 16., 45., 8., 18., 0.5, 12., 18., 5., 5.
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_ISOPRENE',em_factor_isoprene)
+
+       !Config Key   = EM_FACTOR_MONOTERPENE
+       !Config Desc  = Monoterpene emission factor 
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 2.0, 2.0, 1.8, 1.4, 1.6, 1.8, 1.4, 1.8, 0.8, 0.8,  0.22, 0.22
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_MONOTERPENE',em_factor_monoterpene)
+
+       !Config Key   = C_LDF_MONO 
+       !Config Desc  = Monoterpenes fraction dependancy to light
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.6
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_LDF_MONO',LDF_mono)
+
+       !Config Key   = C_LDF_SESQ 
+       !Config Desc  = Sesquiterpenes fraction dependancy to light
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.5
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_LDF_SESQ',LDF_sesq)
+
+       !Config Key   = C_LDF_METH 
+       !Config Desc  = Methanol fraction dependancy to light
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.8
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_LDF_METH',LDF_meth)
+
+       !Config Key   = C_LDF_ACET 
+       !Config Desc  = Acetone fraction dependancy to light
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.2
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_LDF_ACET',LDF_acet)
+
+       !Config Key   = EM_FACTOR_APINENE 
+       !Config Desc  = Alfa pinene  emission factor 
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 1.35, 1.35, 0.85, 0.95, 0.75, 0.85, 0.60, 1.98, 0.30, 0.30, 0.09, 0.09
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_APINENE',em_factor_apinene)
+
+       !Config Key   = EM_FACTOR_BPINENE
+       !Config Desc  = Beta pinene  emission factor
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 0.30, 0.30, 0.35, 0.25, 0.20, 0.35, 0.12, 0.45, 0.16, 0.12, 0.05, 0.05
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_BPINENE',em_factor_bpinene)
+
+       !Config Key   = EM_FACTOR_LIMONENE
+       !Config Desc  = Limonene  emission factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.25, 0.25, 0.20, 0.25, 0.14, 0.20, 0.135, 0.11, 0.19, 0.42, 0.03, 0.03
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_LIMONENE',em_factor_limonene)
+
+       !Config Key   = EM_FACTOR_MYRCENE
+       !Config Desc  = Myrcene  emission factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.20, 0.20, 0.12, 0.11, 0.065, 0.12, 0.036, 0.075, 0.08,  0.085, 0.015, 0.015
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_MYRCENE',em_factor_myrcene)
+
+       !Config Key   = EM_FACTOR_SABINENE
+       !Config Desc  = Sabinene  emission factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.20, 0.20, 0.12, 0.17, 0.70, 0.12, 0.50, 0.09, 0.085, 0.075, 0.02, 0.02
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_SABINENE',em_factor_sabinene)
+
+       !Config Key   = EM_FACTOR_CAMPHENE 
+       !Config Desc  = Camphene  emission factor 
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.15, 0.15, 0.10, 0.10, 0.01, 0.10, 0.01, 0.07, 0.07, 0.08, 0.01, 0.01
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_CAMPHENE',em_factor_camphene)
+
+       !Config Key   = EM_FACTOR_3CARENE 
+       !Config Desc  = 3-Carene  emission factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.13, 0.13, 0.42, 0.02, 0.055, 0.42,0.025, 0.125, 0.085, 0.085, 0.065, 0.065
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_3CARENE',em_factor_3carene)
+
+       !Config Key   = EM_FACTOR_TBOCIMENE
+       !Config Desc  = T-beta-ocimene  emission factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.25, 0.25, 0.13, 0.09, 0.26, 0.13, 0.20, 0.085, 0.18, 0.18, 0.01, 0.01
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_TBOCIMENE', em_factor_tbocimene)
+
+       !Config Key   = EM_FACTOR_OTHERMONOT
+       !Config Desc  = Other monoterpenes  emission factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.17, 0.17, 0.11, 0.11, 0.125, 0.11, 0.274, 0.01, 0.15, 0.155, 0.035, 0.035
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_OTHERMONOT',em_factor_othermonot)
+
+       !Config Key   = EM_FACTOR_SESQUITERP 
+       !Config Desc  = Sesquiterpenes  emission factor 
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.45, 0.45, 0.13, 0.3, 0.36, 0.15, 0.3, 0.25, 0.6, 0.6, 0.08, 0.08
+       !Config Help  =
+       !Config Units = [ugC/g/h] 
+       CALL getin_p('EM_FACTOR_SESQUITERP',em_factor_sesquiterp)
+
+
+
+       !Config Key   = C_BETA_MONO 
+       !Config Desc  = Monoterpenes temperature dependency coefficient
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.1
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_BETA_MONO',beta_mono)
+
+       !Config Key   = C_BETA_SESQ 
+       !Config Desc  = Sesquiterpenes temperature dependency coefficient
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.17
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_BETA_SESQ',beta_sesq)
+
+       !Config Key   = C_BETA_METH 
+       !Config Desc  = Methanol temperature dependency coefficient
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.08
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_BETA_METH',beta_meth)
+
+       !Config Key   = C_BETA_ACET 
+       !Config Desc  = Acetone temperature dependency coefficient
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.1
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_BETA_ACET',beta_acet)
+
+       !Config Key   = C_BETA_OXYVOC 
+       !Config Desc  = Other oxygenated BVOC temperature dependency coefficient
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0.13
+       !Config Help  =
+       !Config Units = []
+       CALL getin_p('C_BETA_OXYVOC',beta_oxyVOC)
+
+       !Config Key   = EM_FACTOR_ORVOC
+       !Config Desc  = ORVOC emissions factor 
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5
+       !Config Help  =
+       !Config Units = [ugC/g/h]  
+       CALL getin_p('EM_FACTOR_ORVOC',em_factor_ORVOC)
+
+       !Config Key   = EM_FACTOR_OVOC
+       !Config Desc  = OVOC emissions factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5
+       !Config Help  =
+       !Config Units = [ugC/g/h]        
+       CALL getin_p('EM_FACTOR_OVOC',em_factor_OVOC)
+
+       !Config Key   = EM_FACTOR_MBO
+       !Config Desc  = MBO emissions factor 
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 2.e-5, 2.e-5, 1.4, 2.e-5, 2.e-5, 0.14, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5
+       !Config Help  =
+       !Config Units = [ugC/g/h]  
+       CALL getin_p('EM_FACTOR_MBO',em_factor_MBO)
+
+       !Config Key   = EM_FACTOR_METHANOL
+       !Config Desc  = Methanol emissions factor 
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 0.8, 0.8, 1.8, 0.9, 1.9, 1.8, 1.8, 1.8, 0.7, 0.9, 2., 2.
+       !Config Help  =
+       !Config Units = [ugC/g/h]  
+       CALL getin_p('EM_FACTOR_METHANOL',em_factor_methanol)
+
+       !Config Key   = EM_FACTOR_ACETONE
+       !Config Desc  = Acetone emissions factor
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 0.25, 0.25, 0.3, 0.2, 0.33, 0.3, 0.25, 0.25, 0.2, 0.2, 0.08, 0.08
+       !Config Help  =
+       !Config Units = [ugC/g/h]     
+       CALL getin_p('EM_FACTOR_ACETONE',em_factor_acetone)
+
+       !Config Key   = EM_FACTOR_ACETAL
+       !Config Desc  = Acetaldehyde emissions factor 
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.2, 0.2, 0.2, 0.2, 0.25, 0.25, 0.16, 0.16, 0.12, 0.12, 0.035, 0.02
+       !Config Help  =
+       !Config Units = [ugC/g/h]  
+       CALL getin_p('EM_FACTOR_ACETAL',em_factor_acetal)
+
+       !Config Key   = EM_FACTOR_FORMAL
+       !Config Desc  = Formaldehyde emissions factor
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 0.04, 0.04, 0.08, 0.04, 0.04, 0.04, 0.04, 0.04, 0.025, 0.025, 0.013, 0.013
+       !Config Help  = 
+       !Config Units = [ugC/g/h]  
+       CALL getin_p('EM_FACTOR_FORMAL',em_factor_formal)
+
+       !Config Key   = EM_FACTOR_ACETIC
+       !Config Desc  = Acetic Acid emissions factor
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 0.025, 0.025,0.025,0.022,0.08,0.025,0.022,0.013,0.012,0.012,0.008,0.008
+       !Config Help  =
+       !Config Units = [ugC/g/h]  
+       CALL getin_p('EM_FACTOR_ACETIC',em_factor_acetic)
+
+       !Config Key   = EM_FACTOR_FORMIC
+       !Config Desc  = Formic Acid emissions factor
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 0.015, 0.015, 0.02, 0.02, 0.025, 0.025, 0.015, 0.015,0.010,0.010,0.008,0.008
+       !Config Help  =
+       !Config Units = [ugC/g/h]  
+       CALL getin_p('EM_FACTOR_FORMIC',em_factor_formic)
+
+       !Config Key   = EM_FACTOR_NO_WET
+       !Config Desc  = NOx emissions factor wet soil emissions and exponential dependancy factor 
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 2.6, 0.06, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.36, 0.36, 0.36, 0.36
+       !Config Help  =
+       !Config Units = [ngN/m^2/s]
+       CALL getin_p('EM_FACTOR_NO_WET',em_factor_no_wet)
+
+       !Config Key   = EM_FACTOR_NO_DRY
+       !Config Desc  = NOx emissions factor dry soil emissions and exponential dependancy factor 
+       !Config if    = CHEMISTRY_BVOC
+       !Config Def   = 0., 8.60, 0.40, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 2.65, 2.65, 2.65, 2.65
+       !Config Help  =
+       !Config Units = [ngN/m^2/s] 
+       CALL getin_p('EM_FACTOR_NO_DRY',em_factor_no_dry)
+
+       !Config Key   = LARCH
+       !Config Desc  = Larcher 1991 SAI/LAI ratio
+       !Config if    = CHEMISTRY_BVOC 
+       !Config Def   = 0., 0.015, 0.015, 0.003, 0.005, 0.005, 0.003, 0.005, 0.003, 0.005, 0.005, 0.008, 0.008
+       !Config Help  =
+       !Config Units = [-]  
+       CALL getin_p('LARCH',Larch)
+
+    ENDIF ! (ok_bvoc)
+
+  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
+
+    !_ ================================================================================================================================
+
+    !
+    ! Vegetation structure
+    !
+
+    !Config Key   = SLA
+    !Config Desc  = specif leaf area 
+    !Config if    = OK_STOMATE
+    !Config Def   = 1.5E-2, 1.53E-2, 2.6E-2, 9.26E-3, 2E-2, 2.6E-2, 9.26E-3, 2.6E-2, 1.9E-2, 2.6E-2, 2.6E-2, 2.6E-2, 2.6E-2
+    !Config Help  =
+    !Config Units = [m^2/gC]
+    CALL getin_p('SLA',sla)
+
+
+    !Config Key   = AVAILABILITY_FACT 
+    !Config Desc  = Calculate dynamic mortality in lpj_gap, pft dependent parameter
+    !Config If    = OK_STOMATE 
+    !Config Def   = undef, 0.14, 0.14, 0.10, 0.10, 0.10, 0.05, 0.05, 0.05, undef, undef, undef, undef 
+    !Config Help  = 
+    !Config Units = [-]   
+    CALL getin_p('AVAILABILITY_FACT',availability_fact)
+
+    !
+    ! Allocation - stomate
+    !
+    !
+    !Config Key   = R0 
+    !Config Desc  = Standard root allocation 
+    !Config If    = OK_STOMATE 
+    !Config Def   = undef, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('R0',R0)
+
+    !Config Key   = S0 
+    !Config Desc  = Standard sapwood allocation 
+    !Config If    = OK_STOMATE 
+    !Config Def   = undef, .25, .25, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30
+    !Config Help  = 
+    !Config Units = [-]    
+    CALL getin_p('S0',S0)
+
+    !
+    ! Respiration - stomate
+    !
+
+    !Config Key   = FRAC_GROWTHRESP
+    !Config Desc  = fraction of GPP which is lost as growth respiration
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 0.35, 0.35, 0.28, 0.28, 0.28, 0.35, 0.35, 0.35, 0.28, 0.28, 0.28, 0.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, 0.12, 0.12, 0.16, 0.16, 0.16, 0.25, 0.25, 0.25, 0.16, 0.12, 0.16, 0.12
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('MAINT_RESP_SLOPE_C',maint_resp_slope_c) 
+
+    !Config Key   = MAINT_RESP_SLOPE_B
+    !Config Desc  = slope of maintenance respiration coefficient (1/K), constant b of aT^2+bT+c , tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, .0, .0, .0, .0, .0, .0, .0, .0, -.00133, .0, -.00133, .0 
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('MAINT_RESP_SLOPE_B',maint_resp_slope_b)
+
+    !Config Key   = MAINT_RESP_SLOPE_A
+    !Config Desc  = slope of maintenance respiration coefficient (1/K), constant a of aT^2+bT+c , tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0    
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('MAINT_RESP_SLOPE_A',maint_resp_slope_a)
+
+    !Config Key   = CM_ZERO_LEAF
+    !Config Desc  = maintenance respiration coefficient at 0 deg C, for leaves, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 2.35E-3, 2.62E-3, 1.01E-3, 2.35E-3, 2.62E-3, 1.01E-3,2.62E-3, 2.05E-3, 2.62E-3, 2.62E-3, 2.62E-3, 2.62E-3
+    !Config Help  =
+    !Config Units = [g/g/day]
+    CALL getin_p('CM_ZERO_LEAF',cm_zero_leaf)
+
+    !Config Key   = CM_ZERO_SAPABOVE
+    !Config Desc  = maintenance respiration coefficient at 0 deg C,for sapwood above, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4
+    !Config Help  =
+    !Config Units = [g/g/day]
+    CALL getin_p('CM_ZERO_SAPABOVE',cm_zero_sapabove)
+
+    !Config Key   = CM_ZERO_SAPBELOW
+    !Config Desc  = maintenance respiration coefficient at 0 deg C, for sapwood below, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4 
+    !Config Help  =
+    !Config Units = [g/g/day]
+    CALL getin_p('CM_ZERO_SAPBELOW',cm_zero_sapbelow)
+
+    !Config Key   = CM_ZERO_HEARTABOVE
+    !Config Desc  = maintenance respiration coefficient at 0 deg C, for heartwood above, tabulated
+    !Config if    = OK_STOMATE 
+    !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+    !Config Help  =
+    !Config Units = [g/g/day]
+    CALL getin_p('CM_ZERO_HEARTABOVE',cm_zero_heartabove)
+
+    !Config Key   = CM_ZERO_HEARTBELOW
+    !Config Desc  = maintenance respiration coefficient at 0 deg C,for heartwood below, tabulated
+    !Config if    = OK_STOMATE 
+    !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+    !Config Help  =
+    !Config Units = [g/g/day] 
+    CALL getin_p('CM_ZERO_HEARTBELOW',cm_zero_heartbelow)
+
+    !Config Key   = CM_ZERO_ROOT
+    !Config Desc  = maintenance respiration coefficient at 0 deg C, for roots, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3
+    !Config Help  =
+    !Config Units = [g/g/day] 
+    CALL getin_p('CM_ZERO_ROOT',cm_zero_root)
+
+    !Config Key   = CM_ZERO_FRUIT
+    !Config Desc  = maintenance respiration coefficient at 0 deg C, for fruits, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4    
+    !Config Help  =
+    !Config Units = [g/g/day] 
+    CALL getin_p('CM_ZERO_FRUIT',cm_zero_fruit)
+
+    !Config Key   = CM_ZERO_CARBRES
+    !Config Desc  = maintenance respiration coefficient at 0 deg C, for carbohydrate reserve, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4
+    !Config Help  =
+    !Config Units = [g/g/day] 
+    CALL getin_p('CM_ZERO_CARBRES',cm_zero_carbres)
+
+    !
+    ! Fire - stomate
+    !
+
+    !Config Key   = FLAM
+    !Config Desc  = flamability: critical fraction of water holding capacity
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, .15, .25, .25, .25, .25, .25, .25, .25, .25, .25, .35, .35
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('FLAM',flam)
+
+    !Config Key   = RESIST
+    !Config Desc  = fire resistance
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, .95, .90, .12, .50, .12, .12, .12, .12, .0, .0, .0, .0 
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('RESIST',resist)
+
+    !
+    ! Flux - LUC
+    !
+
+    !Config Key   = COEFF_LCCHANGE_1
+    !Config Desc  = Coeff of biomass export for the year
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 0.897, 0.897, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597 
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('COEFF_LCCHANGE_1',coeff_lcchange_1)
+
+    !Config Key   = COEFF_LCCHANGE_10
+    !Config Desc  = Coeff of biomass export for the decade
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 0.103, 0.103, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.403, 0.299, 0.403
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('COEFF_LCCHANGE_10',coeff_lcchange_10)
+
+    !Config Key   = COEFF_LCCHANGE_100
+    !Config Desc  = Coeff of biomass export for the century
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 0., 0., 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0., 0.104, 0.
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('COEFF_LCCHANGE_100',coeff_lcchange_100)
+
+    !
+    ! Phenology
+    !
+
+    !Config Key   = LAI_MAX_TO_HAPPY
+    !Config Desc  = threshold of LAI below which plant uses carbohydrate reserves
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5 
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('LAI_MAX_TO_HAPPY',lai_max_to_happy) 
+
+    !Config Key   = LAI_MAX
+    !Config Desc  = maximum LAI, PFT-specific
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 7.0, 5.0, 5.0, 4.0, 5.0, 3.5, 4.0, 3.0, 2.5, 2.0, 5.0, 5.0
+    !Config Help  =
+    !Config Units = [m^2/m^2]
+    CALL getin_p('LAI_MAX',lai_max)
+
+    !Config Key   = PHENO_TYPE
+    !Config Desc  = type of phenology, 0=bare ground 1=evergreen,  2=summergreen,  3=raingreen,  4=perennial
+    !Config if    = OK_STOMATE
+    !Config Def   = 0, 1, 3, 1, 1, 2, 1, 2, 2, 4, 4, 2, 3
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('PHENO_TYPE',pheno_type)
+
+    !
+    ! Phenology : Leaf Onset
+    !
+
+    !Config Key   = PHENO_GDD_CRIT_C
+    !Config Desc  = critical gdd, tabulated (C), constant c of aT^2+bT+c
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 270., 400., 125., 400.
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('PHENO_GDD_CRIT_C',pheno_gdd_crit_c)
+
+    !Config Key   = PHENO_GDD_CRIT_B
+    !Config Desc  = critical gdd, tabulated (C), constant b of aT^2+bT+c
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, undef, undef,undef, undef, 6.25, 0., 0., 0.
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('PHENO_GDD_CRIT_B',pheno_gdd_crit_b)
+
+    !Config Key   = PHENO_GDD_CRIT_A
+    !Config Desc  = critical gdd, tabulated (C), constant a of aT^2+bT+c
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.03125,  0., 0., 0.
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('PHENO_GDD_CRIT_A',pheno_gdd_crit_a)
+
+    !Config Key   = PHENO_MOIGDD_T_CRIT
+    !Config Desc  = Average temperature threashold for C4 grass used in pheno_moigdd
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 22.0, undef, undef
+    !Config Help  =
+    !Config Units = [C]
+    CALL getin_p('PHENO_MOIGDD_T_CRIT',pheno_moigdd_t_crit)
+
+    !Config Key   = NGD_CRIT
+    !Config Desc  = critical ngd, tabulated. Threshold -5 degrees
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, undef, undef, 0., undef, undef, undef, undef, undef
+    !Config Help  = NGD : Number of Growing Days.
+    !Config Units = [days]
+    CALL getin_p('NGD_CRIT',ngd_crit)
+
+    !Config Key   = NCDGDD_TEMP
+    !Config Desc  = critical temperature for the ncd vs. gdd function in phenology
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, 5., undef, 0., undef, undef, undef, undef, undef
+    !Config Help  =
+    !Config Units = [C] 
+    CALL getin_p('NCDGDD_TEMP',ncdgdd_temp)
+
+    !Config Key   = HUM_FRAC
+    !Config Desc  = critical humidity (relative to min/max) for phenology
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, .5, undef, undef, undef, undef, undef,  undef, .5, .5, .5,.5     
+    !Config Help  =
+    !Config Units = [%]
+    CALL getin_p('HUM_FRAC',hum_frac)
+
+    !Config Key   = HUM_MIN_TIME
+    !Config Desc  = minimum time elapsed since moisture minimum
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, 50., undef, undef, undef, undef, undef, undef, 35., 35., 75., 75.
+    !Config Help  =
+    !Config Units = [days]
+    CALL getin_p('HUM_MIN_TIME',hum_min_time)
+
+    !Config Key   = TAU_SAP
+    !Config Desc  = sapwood -> heartwood conversion time
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 730., 730., 730., 730., 730., 730., 730., 730., undef, undef, undef, undef
+    !Config Help  =
+    !Config Units = [days]
+    CALL getin_p('TAU_SAP',tau_sap)
+
+    !Config Key   = TAU_LEAFINIT
+    !Config Desc  = time to attain the initial foliage using the carbohydrate reserve
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10.
+    !Config Help  =
+    !Config Units = [days]
+    CALL getin_p('TAU_LEAFINIT',tau_leafinit) 
+
+    !Config Key   = TAU_FRUIT
+    !Config Desc  = fruit lifetime
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 90., 90., 90., 90., 90., 90., 90., 90., undef, undef, undef, undef
+    !Config Help  =
+    !Config Units = [days]
+    CALL getin_p('TAU_FRUIT',tau_fruit)
+
+    !Config Key   = ECUREUIL
+    !Config Desc  = fraction of primary leaf and root allocation put into reserve
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, .0, 1., .0, .0, 1., .0, 1., 1., 1., 1., 1., 1.
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('ECUREUIL',ecureuil)
+
+    !Config Key   = ALLOC_MIN
+    !Config Desc  = minimum allocation above/below = f(age) - 30/01/04 NV/JO/PF
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, undef, undef, undef, undef 
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('ALLOC_MIN',alloc_min)
+
+    !Config Key   = ALLOC_MAX
+    !Config Desc  = maximum allocation above/below = f(age) - 30/01/04 NV/JO/PF
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, undef, undef, undef, undef
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('ALLOC_MAX',alloc_max)
+
+    !Config Key   = DEMI_ALLOC 
+    !Config Desc  = mean allocation above/below = f(age) - 30/01/04 NV/JO/PF
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 5., 5., 5., 5., 5., 5., 5., 5., undef, undef, undef, undef
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('DEMI_ALLOC',demi_alloc)
+
+    !Config Key   = LEAFLIFE_TAB
+    !Config Desc  = leaf longevity
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, .5, 2., .33, 1., 2., .33, 2., 2., 2., 2., 2., 2. 
+    !Config Help  =
+    !Config Units = [years]
+    CALL getin_p('LEAFLIFE_TAB',leaflife_tab)
+
+    !
+    ! Phenology : Senescence
+    !
+    !
+    !Config Key   = LEAFFALL
+    !Config Desc  = length of death of leaves, tabulated 
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, 10., undef, undef, 10., undef, 10., 10., 10., 10., 10., 10. 
+    !Config Help  =
+    !Config Units = [days]
+    CALL getin_p('LEAFFALL',leaffall)
+
+    !Config Key   = LEAFAGECRIT
+    !Config Desc  = critical leaf age, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, 730., 180., 910., 730., 180., 910., 180., 180., 120., 120., 90., 90.  
+    !Config Help  =
+    !Config Units = [days]
+    CALL getin_p('LEAFAGECRIT',leafagecrit) 
+
+    !Config Key   = SENESCENCE_TYPE
+    !Config Desc  = type of senescence, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = none, none, dry, none, none, cold, none, cold, cold, mixed, mixed, mixed, mixed 
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('SENESCENCE_TYPE',senescence_type) 
+
+    !Config Key   = SENESCENCE_HUM
+    !Config Desc  = critical relative moisture availability for senescence
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, .3, undef, undef, undef, undef, undef, undef, .2, .2, .3, .2 
+    !Config Help  =
+    !Config Units = [-] 
+    CALL getin_p('SENESCENCE_HUM',senescence_hum)
+
+    !Config Key   = NOSENESCENCE_HUM
+    !Config Desc  = relative moisture availability above which there is no humidity-related senescence
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, .8, undef, undef, undef, undef, undef, undef, .3, .3, .3, .3 
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('NOSENESCENCE_HUM',nosenescence_hum) 
+
+    !Config Key   = MAX_TURNOVER_TIME
+    !Config Desc  = maximum turnover time for grasse
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef,  80.,  80., 80., 80. 
+    !Config Help  =
+    !Config Units = [days]
+    CALL getin_p('MAX_TURNOVER_TIME',max_turnover_time)
+
+    !Config Key   = MIN_TURNOVER_TIME
+    !Config Desc  = minimum turnover time for grasse 
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 10., 10., 10., 10. 
+    !Config Help  =
+    !Config Units = [days]
+    CALL getin_p('MIN_TURNOVER_TIME',min_turnover_time)
+
+    !Config Key   = MIN_LEAF_AGE_FOR_SENESCENCE
+    !Config Desc  = minimum leaf age to allow senescence g
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, 90., undef, undef, 90., undef, 60., 60., 30., 30., 30., 30.
+    !Config Help  =
+    !Config Units = [days] 
+    CALL getin_p('MIN_LEAF_AGE_FOR_SENESCENCE',min_leaf_age_for_senescence)
+
+    !Config Key   = SENESCENCE_TEMP_C
+    !Config Desc  = critical temperature for senescence (C), constant c of aT^2+bT+c, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, 12., undef, 7., 2., -1.375, 5., 5., 10.
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('SENESCENCE_TEMP_C',senescence_temp_c)
+
+    !Config Key   = SENESCENCE_TEMP_B
+    !Config Desc  = critical temperature for senescence (C), constant b of aT^2+bT+c ,tabulated
+    !Config if    = OK_STOMATE 
+    !Config Def   = undef, undef, undef, undef, undef, 0., undef, 0., 0., .1, 0., 0., 0.
+    !Config Help  =
+    !Config Units = [-]
+    CALL getin_p('SENESCENCE_TEMP_B',senescence_temp_b)
+
+    !Config Key   = SENESCENCE_TEMP_A
+    !Config Desc  = critical temperature for senescence (C), constant a of aT^2+bT+c , tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, 0., undef, 0., 0.,.00375, 0., 0., 0. 
+    !Config Help  =
+    !Config Units = [-] 
+    CALL getin_p('SENESCENCE_TEMP_A',senescence_temp_a)
+
+    !Config Key   = GDD_SENESCENCE
+    !Config Desc  = minimum gdd to allow senescence of crops  
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 950., 4000.
+    !Config Help  =
+    !Config Units = [days] 
+    CALL getin_p("GDD_SENESCENCE", gdd_senescence)
+
+    !Config Key   = ALWAYS_INIT
+    !Config Desc  = Take carbon from atmosphere if carbohydrate reserve too small
+    !Config if    = OK_STOMATE
+    !Config Def   = y, y, y, y, y, y, y, y, y, y, n, y, y
+    !Config Help  =
+    !Config Units = [BOOLEAN]
+    CALL getin_p('ALWAYS_INIT',always_init)
+
+    !
+    ! DGVM
+    !
+
+    !Config Key   = RESIDENCE_TIME
+    !Config Desc  = residence time of trees
+    !Config if    = OK_DGVM and NOT(LPJ_GAP_CONST_MORT)
+    !Config Def   = undef, 30.0, 30.0, 40.0, 40.0, 40.0, 80.0, 80.0, 80.0, 0.0, 0.0, 0.0, 0.0 
+    !Config Help  =
+    !Config Units = [years]
+    CALL getin_p('RESIDENCE_TIME',residence_time)
+
+    !Config Key   = TMIN_CRIT
+    !Config Desc  = critical tmin, tabulated
+    !Config if    = OK_STOMATE
+    !Config Def   = undef,  0.0, 0.0, -30.0, -14.0, -30.0, -45.0, -45.0, undef, undef, undef, undef, undef
+    !Config Help  = 
+    !Config Units = [C]
+    CALL getin_p('TMIN_CRIT',tmin_crit)
+
+    !Config Key   = TCM_CRIT
+    !Config Desc  = critical tcm, tabulated 
+    !Config if    = OK_STOMATE
+    !Config Def   = undef, undef, undef, 5.0, 15.5, 15.5, -8.0, -8.0, -8.0, undef, undef, undef, undef
+    !Config Help  =
+    !Config Units = [C]
+    CALL getin_p('TCM_CRIT',tcm_crit)
+
+  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(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_vis)) DEALLOCATE(snowa_aged_vis)
+    IF (ALLOCATED(snowa_aged_nir)) DEALLOCATE(snowa_aged_nir)
+    IF (ALLOCATED(snowa_dec_vis)) DEALLOCATE(snowa_dec_vis)
+    IF (ALLOCATED(snowa_dec_nir)) DEALLOCATE(snowa_dec_nir)
+    IF (ALLOCATED(alb_leaf_vis)) DEALLOCATE(alb_leaf_vis)
+    IF (ALLOCATED(alb_leaf_nir)) DEALLOCATE(alb_leaf_nir)   
+    IF (ALLOCATED(em_factor_isoprene)) DEALLOCATE(em_factor_isoprene)
+    IF (ALLOCATED(em_factor_monoterpene)) DEALLOCATE(em_factor_monoterpene)
+    IF (ALLOCATED(em_factor_apinene)) DEALLOCATE(em_factor_apinene)
+    IF (ALLOCATED(em_factor_bpinene)) DEALLOCATE(em_factor_bpinene)
+    IF (ALLOCATED(em_factor_limonene)) DEALLOCATE(em_factor_limonene)
+    IF (ALLOCATED(em_factor_myrcene)) DEALLOCATE(em_factor_myrcene)
+    IF (ALLOCATED(em_factor_sabinene)) DEALLOCATE(em_factor_sabinene)
+    IF (ALLOCATED(em_factor_camphene)) DEALLOCATE(em_factor_camphene)
+    IF (ALLOCATED(em_factor_3carene)) DEALLOCATE(em_factor_3carene)
+    IF (ALLOCATED(em_factor_tbocimene)) DEALLOCATE(em_factor_tbocimene)
+    IF (ALLOCATED(em_factor_othermonot)) DEALLOCATE(em_factor_othermonot)
+    IF (ALLOCATED(em_factor_sesquiterp)) DEALLOCATE(em_factor_sesquiterp)
+    IF (ALLOCATED(em_factor_ORVOC)) DEALLOCATE(em_factor_ORVOC)
+    IF (ALLOCATED(em_factor_OVOC)) DEALLOCATE(em_factor_OVOC)
+    IF (ALLOCATED(em_factor_MBO)) DEALLOCATE(em_factor_MBO)
+    IF (ALLOCATED(em_factor_methanol)) DEALLOCATE(em_factor_methanol)
+    IF (ALLOCATED(em_factor_acetone)) DEALLOCATE(em_factor_acetone)
+    IF (ALLOCATED(em_factor_acetal)) DEALLOCATE(em_factor_acetal)
+    IF (ALLOCATED(em_factor_formal)) DEALLOCATE(em_factor_formal)
+    IF (ALLOCATED(em_factor_acetic)) DEALLOCATE(em_factor_acetic)
+    IF (ALLOCATED(em_factor_formic)) DEALLOCATE(em_factor_formic)
+    IF (ALLOCATED(em_factor_no_wet)) DEALLOCATE(em_factor_no_wet)
+    IF (ALLOCATED(em_factor_no_dry)) DEALLOCATE(em_factor_no_dry)
+    IF (ALLOCATED(Larch)) DEALLOCATE(Larch)
+    IF (ALLOCATED(leaf_tab)) DEALLOCATE(leaf_tab)
+    IF (ALLOCATED(sla)) DEALLOCATE(sla)
+    IF (ALLOCATED(availability_fact)) DEALLOCATE(availability_fact)
+    IF (ALLOCATED(R0)) DEALLOCATE(R0)
+    IF (ALLOCATED(S0)) DEALLOCATE(S0)
+    IF (ALLOCATED(L0)) DEALLOCATE(L0)
+    IF (ALLOCATED(frac_growthresp)) DEALLOCATE(frac_growthresp)
+    IF (ALLOCATED(maint_resp_slope)) DEALLOCATE(maint_resp_slope)
+    IF (ALLOCATED(maint_resp_slope_c)) DEALLOCATE(maint_resp_slope_c)
+    IF (ALLOCATED(maint_resp_slope_b)) DEALLOCATE(maint_resp_slope_b)
+    IF (ALLOCATED(maint_resp_slope_a)) DEALLOCATE(maint_resp_slope_a)
+    IF (ALLOCATED(coeff_maint_zero)) DEALLOCATE(coeff_maint_zero)
+    IF (ALLOCATED(cm_zero_leaf)) DEALLOCATE(cm_zero_leaf)
+    IF (ALLOCATED(cm_zero_sapabove)) DEALLOCATE(cm_zero_sapabove)
+    IF (ALLOCATED(cm_zero_sapbelow)) DEALLOCATE(cm_zero_sapbelow)
+    IF (ALLOCATED(cm_zero_heartabove)) DEALLOCATE(cm_zero_heartabove)
+    IF (ALLOCATED(cm_zero_heartbelow)) DEALLOCATE(cm_zero_heartbelow)
+    IF (ALLOCATED(cm_zero_root)) DEALLOCATE(cm_zero_root)
+    IF (ALLOCATED(cm_zero_fruit)) DEALLOCATE(cm_zero_fruit)
+    IF (ALLOCATED(cm_zero_carbres)) DEALLOCATE(cm_zero_carbres)
+    IF (ALLOCATED(flam)) DEALLOCATE(flam)
+    IF (ALLOCATED(resist)) DEALLOCATE(resist)
+    IF (ALLOCATED(coeff_lcchange_1)) DEALLOCATE(coeff_lcchange_1)
+    IF (ALLOCATED(coeff_lcchange_10)) DEALLOCATE(coeff_lcchange_10)
+    IF (ALLOCATED(coeff_lcchange_100)) DEALLOCATE(coeff_lcchange_100)
+    IF (ALLOCATED(lai_max_to_happy)) DEALLOCATE(lai_max_to_happy)
+    IF (ALLOCATED(lai_max)) DEALLOCATE(lai_max)
+    IF (ALLOCATED(pheno_model)) DEALLOCATE(pheno_model)
+    IF (ALLOCATED(pheno_type)) DEALLOCATE(pheno_type)
+    IF (ALLOCATED(pheno_gdd_crit_c)) DEALLOCATE(pheno_gdd_crit_c)
+    IF (ALLOCATED(pheno_gdd_crit_b)) DEALLOCATE(pheno_gdd_crit_b)
+    IF (ALLOCATED(pheno_gdd_crit_a)) DEALLOCATE(pheno_gdd_crit_a)
+    IF (ALLOCATED(pheno_gdd_crit)) DEALLOCATE(pheno_gdd_crit)
+    IF (ALLOCATED(pheno_moigdd_t_crit)) DEALLOCATE(pheno_moigdd_t_crit)
+    IF (ALLOCATED(ngd_crit)) DEALLOCATE(ngd_crit)
+    IF (ALLOCATED(ncdgdd_temp)) DEALLOCATE(ncdgdd_temp)
+    IF (ALLOCATED(hum_frac)) DEALLOCATE(hum_frac)
+    IF (ALLOCATED(hum_min_time)) DEALLOCATE(hum_min_time)
+    IF (ALLOCATED(tau_sap)) DEALLOCATE(tau_sap)
+    IF (ALLOCATED(tau_leafinit)) DEALLOCATE(tau_leafinit)
+    IF (ALLOCATED(tau_fruit)) DEALLOCATE(tau_fruit)
+    IF (ALLOCATED(ecureuil)) DEALLOCATE(ecureuil)
+    IF (ALLOCATED(alloc_min)) DEALLOCATE(alloc_min)
+    IF (ALLOCATED(alloc_max)) DEALLOCATE(alloc_max)
+    IF (ALLOCATED(demi_alloc)) DEALLOCATE(demi_alloc)
+    IF (ALLOCATED(leaflife_tab)) DEALLOCATE(leaflife_tab)
+    IF (ALLOCATED(leaffall)) DEALLOCATE(leaffall)
+    IF (ALLOCATED(leafagecrit)) DEALLOCATE(leafagecrit)
+    IF (ALLOCATED(senescence_type)) DEALLOCATE(senescence_type)
+    IF (ALLOCATED(senescence_hum)) DEALLOCATE(senescence_hum)
+    IF (ALLOCATED(nosenescence_hum)) DEALLOCATE(nosenescence_hum)
+    IF (ALLOCATED(max_turnover_time)) DEALLOCATE(max_turnover_time)
+    IF (ALLOCATED(min_turnover_time)) DEALLOCATE(min_turnover_time)
+    IF (ALLOCATED(min_leaf_age_for_senescence)) DEALLOCATE(min_leaf_age_for_senescence)
+    IF (ALLOCATED(senescence_temp_c)) DEALLOCATE(senescence_temp_c)
+    IF (ALLOCATED(senescence_temp_b)) DEALLOCATE(senescence_temp_b)
+    IF (ALLOCATED(senescence_temp_a)) DEALLOCATE(senescence_temp_a)
+    IF (ALLOCATED(senescence_temp)) DEALLOCATE(senescence_temp)
+    IF (ALLOCATED(gdd_senescence)) DEALLOCATE(gdd_senescence)
+    IF (ALLOCATED(always_init)) DEALLOCATE(always_init)
+    IF (ALLOCATED(residence_time)) DEALLOCATE(residence_time)
+    IF (ALLOCATED(tmin_crit)) DEALLOCATE(tmin_crit)
+    IF (ALLOCATED(tcm_crit)) DEALLOCATE(tcm_crit)
+    IF (ALLOCATED(lai_initmin)) DEALLOCATE(lai_initmin)
+    IF (ALLOCATED(bm_sapl)) DEALLOCATE(bm_sapl)
+    IF (ALLOCATED(migrate)) DEALLOCATE(migrate)
+    IF (ALLOCATED(maxdia)) DEALLOCATE(maxdia)
+    IF (ALLOCATED(cn_sapl)) DEALLOCATE(cn_sapl)
+    IF (ALLOCATED(leaf_timecst)) DEALLOCATE(leaf_timecst)
+
+  END SUBROUTINE pft_parameters_clear
+
+END MODULE pft_parameters
Index: /branches/publications/ORCHIDEE-AFP/src_parameters/pft_parameters_var.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/pft_parameters_var.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/pft_parameters_var.f90	(revision 8430)
@@ -0,0 +1,697 @@
+! =================================================================================================================================
+! MODULE       : pft_parameters_var
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module contains the variables in function of plant funtional type (pft).
+!!
+!!\n DESCRIPTION: This module contains the declarations for the externalized variables in function of the 
+!!                plant foncional type(pft). \n
+!!                The module is already USE in module pft_parameters. Therefor no need to USE it seperatly except
+!!                if the subroutines in module pft_parameters are not needed.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE pft_parameters_var
+
+  USE defprec
+  
+  IMPLICIT NONE
+
+
+  !
+  ! PFT GLOBAL
+  !
+  INTEGER(i_std), SAVE :: nvm = 13                               !! Number of vegetation types (2-N, unitless)
+!$OMP THREADPRIVATE(nvm)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pft_to_mtc  !! Table of conversion : we associate one pft to one metaclass 
+                                                                 !! (1-13, unitless)
+!$OMP THREADPRIVATE(pft_to_mtc)
+
+  CHARACTER(LEN=34), ALLOCATABLE, SAVE, DIMENSION(:) :: PFT_name !! Description of the PFT (unitless)
+!$OMP THREADPRIVATE(PFT_name)
+
+  LOGICAL, SAVE   :: l_first_pft_parameters = .TRUE.             !! To keep first call trace of the module (true/false)
+!$OMP THREADPRIVATE(l_first_pft_parameters)
+
+  !
+  ! VEGETATION STRUCTURE
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_tab       !! leaf type (1-4, unitless)
+                                                                    !! 1=broad leaved tree, 2=needle leaved tree, 
+                                                                    !! 3=grass 4=bare ground 
+!$OMP THREADPRIVATE(leaf_tab)
+
+  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_model  !! which phenology model is used? (tabulated) (unitless)
+!$OMP THREADPRIVATE(pheno_model)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tree               !! Is the vegetation type a tree ? (true/false)
+!$OMP THREADPRIVATE(is_tree)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_deciduous          !! Is PFT deciduous ? (true/false)
+!$OMP THREADPRIVATE(is_deciduous)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_evergreen          !! Is PFT evegreen ? (true/false)
+!$OMP THREADPRIVATE(is_evergreen)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_needleleaf         !! Is PFT needleleaf ? (true/false)
+!$OMP THREADPRIVATE(is_needleleaf)
+ 
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tropical           !! Is PFT tropical ? (true/false)
+!$OMP THREADPRIVATE(is_tropical)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: natural               !! natural? (true/false)
+!$OMP THREADPRIVATE(natural)
+
+  CHARACTER(len=5), ALLOCATABLE, SAVE, DIMENSION(:) :: type_of_lai  !! Type of behaviour of the LAI evolution algorithm 
+                                                                    !! for each vegetation type.
+                                                                    !! Value of type_of_lai, one for each vegetation type :
+                                                                    !! mean or interp
+!$OMP THREADPRIVATE(type_of_lai)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: veget_ori_fixed_test_1 !! Value for veget_ori for tests in 0-dim simulations 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(veget_ori_fixed_test_1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimax                !! laimax for maximum lai see also type of lai 
+                                                                         !! interpolation
+                                                                         !! @tex $(m^2.m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(llaimax)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimin                !! laimin for minimum lai see also type of lai 
+                                                                         !! interpolation 
+                                                                         !! @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(llaimin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: height_presc           !! prescribed height of vegetation.(m)
+                                                                         !! Value for height_presc : one for each vegetation type
+!$OMP THREADPRIVATE(height_presc)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: 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(:) :: 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 !! Percent by PFT of precip that is not intercepted by the canopy
+!$OMP THREADPRIVATE(throughfall_by_pft)
+
+  !
+  ! ALBEDO (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_aged_vis !! Minimum snow albedo value for each vegetation type
+                                                                 !! after aging (dirty old snow), visible albedo (unitless)
+                                                                 !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_aged_vis)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_aged_nir !! Minimum snow albedo value for each vegetation type
+                                                                 !! after aging (dirty old snow), near infrared albedo (unitless)
+                                                                 !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_aged_nir)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_dec_vis  !! Decay rate of snow albedo value for each vegetation type
+                                                                 !! as it will be used in condveg_snow, visible albedo (unitless)
+                                                                 !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_dec_vis)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_dec_nir  !! Decay rate of snow albedo value for each vegetation type
+                                                                 !! as it will be used in condveg_snow, near infrared albedo (unitless)
+                                                                 !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_dec_nir)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alb_leaf_vis  !! leaf albedo of vegetation type, visible albedo (unitless)
+!$OMP THREADPRIVATE(alb_leaf_vis)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alb_leaf_nir  !! leaf albedo of vegetation type, near infrared albedo (unitless)
+!$OMP THREADPRIVATE(alb_leaf_nir)
+
+  !
+  ! SOIL - VEGETATION
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pref_soil_veg      !! Table which contains the correlation between the soil
+                                                                        !! types and vegetation type. Two modes exist :
+                                                                        !! 1) pref_soil_veg = 0 then we have an equidistribution
+                                                                        !!    of vegetation on soil types
+                                                                        !! 2) Else for each pft the prefered soil type is given :
+                                                                        !!    1=sand, 2=loan, 3=clay
+                                                                        !! This variable is initialized in slowproc.(1-3, unitless)
+!$OMP THREADPRIVATE(pref_soil_veg)
+
+  !
+  ! PHOTOSYNTHESIS
+  !
+  !-
+  ! 1. CO2
+  !-
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_c4             !! flag for C4 vegetation types (true/false)
+!$OMP THREADPRIVATE(is_c4)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: vcmax_fix     !! values used for vcmax when STOMATE is not activated
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(vcmax_fix)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: downregulation_co2_coeff !! Coefficient for CO2 downregulation (unitless)
+!$OMP THREADPRIVATE(downregulation_co2_coeff)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_KmC         !! Energy of activation for KmC (J mol-1)
+!$OMP THREADPRIVATE(E_KmC)                                                               
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_KmO         !! Energy of activation for KmO (J mol-1)
+!$OMP THREADPRIVATE(E_KmO)          
+REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_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)
+
+
+  !
+  ! ALLOCATION (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: R0            !! Default root allocation (0-1, unitless)
+!$OMP THREADPRIVATE(R0)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: S0            !! Default sapwood allocation (0-1, unitless)
+!$OMP THREADPRIVATE(S0)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: L0            !! Default leaf allocation (0-1, unitless)
+!$OMP THREADPRIVATE(L0)
+
+
+  !
+  ! RESPIRATION (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: frac_growthresp  !! fraction of GPP which is lost as growth respiration
+
+!$OMP THREADPRIVATE(frac_growthresp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: maint_resp_slope  !! slope of maintenance respiration coefficient 
+                                                                      !! (1/K, 1/K^2, 1/K^3), used in the code
+!$OMP THREADPRIVATE(maint_resp_slope)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_c  !! slope of maintenance respiration coefficient (1/K),
+                                                                      !! constant c of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_b  !! slope of maintenance respiration coefficient (1/K), 
+                                                                      !! constant b of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_a  !! slope of maintenance respiration coefficient (1/K), 
+                                                                      !! constant a of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: coeff_maint_zero  !! maintenance respiration coefficient at 0 deg C, 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(coeff_maint_zero)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_leaf        !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for leaves, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_leaf)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_sapabove    !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for sapwood above, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_sapabove)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_sapbelow    !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for sapwood below, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_sapbelow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_heartabove  !! maintenance respiration coefficient at 0 deg C
+                                                                      !! for heartwood above, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_heartabove)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_heartbelow  !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for heartwood below, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_heartbelow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_root        !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for roots, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_root)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_fruit       !! maintenance respiration coefficient  at 0 deg C,
+                                                                      !! for fruits, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_fruit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_carbres     !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for carbohydrate reserve, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_carbres)
+
+ 
+  !
+  ! FIRE (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flam              !! flamability : critical fraction of water holding 
+                                                                    !! capacity (0-1, unitless)
+!$OMP THREADPRIVATE(flam)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: resist            !! fire resistance (0-1, unitless)
+!$OMP THREADPRIVATE(resist)
+
+
+  !
+  ! FLUX - LUC (Land Use Change)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_1   !! Coeff of biomass export for the year (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_10  !! Coeff of biomass export for the decade (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_10)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_100 !! Coeff of biomass export for the century (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_100)
+ 
+ 
+  !
+  ! PHENOLOGY
+  !
+  !-
+  ! 1. Stomate
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max_to_happy  !! threshold of LAI below which plant uses carbohydrate reserves
+!$OMP THREADPRIVATE(lai_max_to_happy)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max           !! maximum LAI, PFT-specific @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(lai_max)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_type     !! type of phenology (0-4, unitless)
+                                                                    !! 0=bare ground 1=evergreen,  2=summergreen, 
+                                                                    !! 3=raingreen,  4=perennial
+                                                                    !! For the moment, the bare ground phenotype is not managed, 
+                                                                    !! so it is considered as "evergreen"
+!$OMP THREADPRIVATE(pheno_type)
+
+  !-
+  ! 2. Leaf Onset
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pheno_gdd_crit   !! critical gdd,tabulated (C), used in the code
+!$OMP THREADPRIVATE(pheno_gdd_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_c   !! critical gdd,tabulated (C), 
+                                                                     !! constant c of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_b   !! critical gdd,tabulated (C), 
+                                                                     !! constant b of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_a   !! critical gdd,tabulated (C), 
+                                                                     !! constant a of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_moigdd_t_crit!! Monthly avearage temperature treashold used for C4 grass (C)
+!$OMP THREADPRIVATE(pheno_moigdd_t_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ngd_crit           !! critical ngd,tabulated. Threshold -5 degrees (days)
+!$OMP THREADPRIVATE(ngd_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ncdgdd_temp        !! critical temperature for the ncd vs. gdd function
+                                                                     !! in phenology (C)
+!$OMP THREADPRIVATE(ncdgdd_temp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_frac           !! critical humidity (relative to min/max) for phenology
+                                                                     !! (0-1, unitless)
+!$OMP THREADPRIVATE(hum_frac)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_min_time       !! minimum time elapsed since moisture minimum (days)
+!$OMP THREADPRIVATE(hum_min_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_sap            !! sapwood -> heartwood conversion time (days)
+!$OMP THREADPRIVATE(tau_sap)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_fruit          !! fruit lifetime (days)
+!$OMP THREADPRIVATE(tau_fruit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_leafinit  !! time to attain the initial foliage using the carbohydrate reserve
+!$OMP THREADPRIVATE(tau_leafinit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ecureuil           !! fraction of primary leaf and root allocation put
+                                                                     !! into reserve (0-1, unitless)
+!$OMP THREADPRIVATE(ecureuil)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_min          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(alloc_min)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_max          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(alloc_max)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: demi_alloc         !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(demi_alloc)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaflife_tab       !! leaf longevity, tabulated (??units??)
+!$OMP THREADPRIVATE(leaflife_tab)
+
+  !-
+  ! 3. Senescence
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaffall              !! length of death of leaves,tabulated (days)
+!$OMP THREADPRIVATE(leaffall)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leafagecrit           !! critical leaf age,tabulated (days)
+!$OMP THREADPRIVATE(leafagecrit)
+
+  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_type  !! type of senescence,tabulated (unitless)
+                                                                        !! List of avaible types of senescence :
+                                                                        !! 'cold  ', 'dry   ', 'mixed ', 'none  '
+!$OMP THREADPRIVATE(senescence_type)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_hum        !! critical relative moisture availability for senescence
+                                                                        !! (0-1, unitless)
+!$OMP THREADPRIVATE(senescence_hum)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: nosenescence_hum      !! relative moisture availability above which there is
+                                                                        !! no humidity-related senescence (0-1, unitless)
+!$OMP THREADPRIVATE(nosenescence_hum)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: max_turnover_time     !! maximum turnover time for grasses (days)
+!$OMP THREADPRIVATE(max_turnover_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_turnover_time     !! minimum turnover time for grasses (days)
+!$OMP THREADPRIVATE(min_turnover_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_leaf_age_for_senescence  !! minimum leaf age to allow senescence g (days)
+!$OMP THREADPRIVATE(min_leaf_age_for_senescence)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: senescence_temp     !! critical temperature for senescence (C),
+                                                                        !! used in the code
+!$OMP THREADPRIVATE(senescence_temp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_c     !! critical temperature for senescence (C), 
+                                                                        !! constant c of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_b     !! critical temperature for senescence (C), 
+                                                                        !! constant b of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_a     !! critical temperature for senescence (C),
+                                                                        !! constant a of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gdd_senescence        !! minimum gdd to allow senescence of crops (days)
+!$OMP THREADPRIVATE(gdd_senescence)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: always_init               !! take carbon from atmosphere if carbohydrate reserve too small? (true/false)
+!$OMP THREADPRIVATE(always_init)
+
+  !
+  ! DGVM
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: residence_time        !! residence time of trees (y) 
+!$OMP THREADPRIVATE(residence_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmin_crit             !! critical tmin, tabulated (C)
+!$OMP THREADPRIVATE(tmin_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tcm_crit              !! critical tcm, tabulated (C)
+!$OMP THREADPRIVATE(tcm_crit)
+
+  !
+  ! Biogenic Volatile Organic Compounds
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_isoprene       !! Isoprene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_isoprene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_monoterpene    !! Monoterpene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_monoterpene)
+
+  REAL(r_std), SAVE :: LDF_mono                                            !! monoterpenes fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_mono) 
+  REAL(r_std), SAVE :: LDF_sesq                                            !! sesquiterpenes fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_sesq)
+  REAL(r_std), SAVE :: LDF_meth                                            !! methanol fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_meth)
+  REAL(r_std), SAVE :: LDF_acet                                            !! acetone fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_acet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_apinene        !! Alfa pinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_apinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_bpinene        !! Beta pinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_bpinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_limonene       !! Limonene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_limonene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_myrcene        !! Myrcene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_myrcene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_sabinene       !! Sabinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_sabinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_camphene       !! Camphene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_camphene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_3carene        !! 3-carene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_3carene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_tbocimene      !! T-beta-ocimene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_tbocimene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_othermonot     !! Other monoterpenes emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_othermonot)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_sesquiterp     !! Sesquiterpene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_sesquiterp)
+
+  REAL(r_std), SAVE :: beta_mono                                           !! Monoterpenes temperature dependency coefficient 
+!$OMP THREADPRIVATE(beta_mono)
+  REAL(r_std), SAVE :: beta_sesq                                           !! Sesquiterpenes temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_sesq)
+  REAL(r_std), SAVE :: beta_meth                                           !! Methanol temperature dependency coefficient 
+!$OMP THREADPRIVATE(beta_meth)
+  REAL(r_std), SAVE :: beta_acet                                           !! Acetone temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_acet)
+  REAL(r_std), SAVE :: beta_oxyVOC                                         !! Other oxygenated BVOC temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_oxyVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_ORVOC          !! ORVOC emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_ORVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_OVOC           !! OVOC emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_OVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_MBO            !! MBO emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_MBO)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_methanol       !! Methanol emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_methanol)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetone        !! Acetone emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetone)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetal         !! Acetaldehyde emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetal)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formal         !! Formaldehyde emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_formal)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetic         !! Acetic Acid emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetic)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formic         !! Formic Acid emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_formic)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_wet         !! NOx emissions factor soil emissions and 
+                                                                           !! exponential dependancy factor for wet soils
+                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_no_wet)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_dry         !! NOx emissions factor soil emissions and
+                                                                           !! exponential dependancy factor for dry soils
+                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_no_dry)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Larch                    !! Larcher 1991 SAI/LAI ratio (unitless)
+!$OMP THREADPRIVATE(Larch)
+
+  !
+  ! INTERNAL PARAMETERS USED IN STOMATE_DATA
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_initmin   !! Initial lai for trees/grass 
+                                                                !! @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(lai_initmin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bm_sapl   !! sapling biomass @tex $(gC.ind^{-1})$ @endtex
+!$OMP THREADPRIVATE(bm_sapl)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: migrate       !! migration speed @tex $(m.year^{-1})$ @endtex
+!$OMP THREADPRIVATE(migrate)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maxdia        !! maximum stem diameter from which on crown area no longer 
+                                                                !! increases (m)
+!$OMP THREADPRIVATE(maxdia)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_sapl       !! crown of tree when sapling  @tex $(m^2$)$ @endtex
+!$OMP THREADPRIVATE(cn_sapl)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_timecst  !! time constant for leaf age discretisation (days)
+!$OMP THREADPRIVATE(leaf_timecst)
+
+
+END MODULE pft_parameters_var
Index: /branches/publications/ORCHIDEE-AFP/src_parameters/vertical_soil.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/vertical_soil.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/vertical_soil.f90	(revision 8430)
@@ -0,0 +1,476 @@
+! ================================================================================================================================
+!  MODULE       : vertical_soil
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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$
+!! $Date$
+!! $Revision$
+!! \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)   :: zint              !! Depth at the interface of each layer (m)
+    REAL(r_std), DIMENSION(nblayermax+1) :: dtmp              !! Distance between the current node and the one above (m)
+    REAL(r_std), DIMENSION(nblayermax+1) :: drefine           !! Related to refine at bottom. Work in progress...
+    INTEGER(i_std), DIMENSION(1)         :: imin              !! Related to refine at bottom. Work in progress...
+
+    !! Variables controling the vertical discretiztaion
+    REAL(r_std)                          :: depth_topthickness   !! Thickness of the top Layer (m)
+    REAL(r_std)                          :: depth_cstthickness   !! Depth at which constant layer thickness start (m)
+    REAL(r_std)                          :: depth_geom           !! Depth at which we resume geometrical increases for temperature (m)
+    REAL(r_std)                          :: ratio_geom_below     !! Ratio of the geometrical series defining the thickness below DEPTH_GEOM.
+    LOGICAL                              :: refinebottom         !! Whether or not the hydrology layers will be refined towards the bottom.
+
+    
+    !! 1. Read parameters from run.def file
+    
+    !Config Key   = DEPTH_MAX_T
+    !Config Desc  = Maximum depth of the soil thermodynamics
+    !Config If    = 
+    !Config Def   = 90.0
+    !Config Help  = Maximum depth of soil for temperature.
+    !Config Units = m
+    zmaxt = 90.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
+    
+    !Config Key   = REFINEBOTTOM
+    !Config Desc  = Depth at which the hydrology layers will be refined towards the bottom.
+    !Config If    = 
+    !Config Def   = .FALSE.
+    !Config Help  =  Refinebottom is important when lower boundary conditions is different from a free drainage.
+    !Config Units = -
+    refinebottom = .FALSE.
+    CALL getin_p("REFINEBOTTOM",refinebottom)
+    
+    !Config Key   = DEPTH_GEOM
+    !Config Desc  = Depth at which we resume geometrical increases for temperature
+    !Config If    = 
+    !Config Def   = DEPTH_MAX_H 
+    !Config Help  = Depth at which the thickness increases again for temperature.
+    !               This depth has to be deeper than the bottom of the hydrology.
+    !Config Units = m
+    depth_geom=zmaxh
+    CALL getin_p("DEPTH_GEOM",depth_geom)
+    
+    IF ( depth_geom < zmaxh ) THEN
+       CALL ipslerr_p(3,'vertical_soil_init',"ERROR : depth_geom needs to be larger than zmaxh", &
+            "Correction : setting depth_geom to zmaxh", " ")
+    ENDIF
+    
+    !Config Key   = RATIO_GEOM_BELOW
+    !Config Desc  = Ratio of the geometrical series defining the thickness below DEPTH_GEOM
+    !Config If    = 
+    !Config Def   = 2
+    !Config Help  = Ratio of the geometrical series defining the thickness below DEPTH_GEOM.
+    !               This parameter allows to cover the depth needed for temperature with fewer layers.
+    !Config Units = -
+    ratio_geom_below=2
+    CALL getin_p("RATIO_GEOM_BELOW",ratio_geom_below)
+    
+    !
+    ! Computing the layer depth for soil moisture. This defines the number of layers needed.
+    !
+    ztmp(:) = 0.0
+    dtmp(:) = 0.0
+    DO i=1,nblayermax
+       IF ( ztmp(i) < depth_cstthickness ) THEN
+          ztmp(i+1) = depth_topthickness*2.0*((2**i)-1)
+          dtmp(i+1) = ztmp(i+1)-ztmp(i)
+          igeo=i+1
+          zgeoend=ztmp(i+1)
+          dgeoend=dtmp(i+1)
+       ELSE
+          ztmp(i+1) = ztmp(i)+dtmp(i)
+          dtmp(i+1) = dtmp(i)
+       ENDIF
+    ENDDO
+    !
+    ! refine at bottom. Work in progress...
+    !
+    nbrefine = 1
+    drefine(:) = 0.0
+    IF (refinebottom) THEN
+       !
+       ! Compute parameters for the constant increment interval before refining,
+       ! If needed !
+       cstint=zmaxh-(2.0*zgeoend)
+       nbcst=MAX(INT(cstint/dgeoend), 0)
+       IF ( nbcst > 0 ) THEN
+          dcst=cstint/nbcst
+       ELSE
+          dcst=dgeoend
+       ENDIF
+       !
+       ! If we have to add constant increments
+       !
+       IF ( nbcst > 0 ) THEN
+          ! Add linear levels
+          DO i=igeo,igeo+nbcst-1
+             ztmp(i+1) = ztmp(i)+dcst
+             dtmp(i+1) = dcst
+          ENDDO
+          ! Refine the levels toward the bottom
+          DO i=igeo+nbcst,2*igeo+nbcst-2
+             irev=(2*igeo+nbcst-1)-i
+             ztmp(i+1) = ztmp(i)+dtmp(irev+1)
+             dtmp(i+1) = ztmp(i+1)-ztmp(i)
+             drefine(nbrefine)=dtmp(i+1)
+             nbrefine=nbrefine+1
+          ENDDO
+          ! Without constant increments
+       ELSE
+          imin=MINLOC(ABS(ztmp(:)-(zmaxh/2.0)))
+          igeo=imin(1)
+          ztmp(igeo)=zmaxh/2.0
+          dtmp(igeo) = ztmp(igeo)-ztmp(igeo-1)
+          DO i=igeo,2*igeo
+             irev=(2*igeo)-i
+             ztmp(i+1) = ztmp(i)+dtmp(irev)
+             dtmp(i+1) = ztmp(i-1)-ztmp(i)
+             drefine(nbrefine)=dtmp(i+1)
+             nbrefine=nbrefine+1
+          ENDDO
+       ENDIF
+       nbrefine = nbrefine-1
+    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. Only done for option refinebottom.   
+    IF ( nbrefine > 1 ) THEN
+       DO i=ntmp,ntmp+nbrefine-1
+          iref=nbrefine-(i-ntmp)
+          ztmp(i+1)=ztmp(i)+drefine(iref)
+       ENDDO
+       ntmp=ntmp+nbrefine
+    ENDIF
+    !
+    ! Resume the geometric increas of thickness
+    DO i=ntmp,nblayermax
+       IF ( ztmp(i) < depth_geom ) THEN
+          ratio = 1.0
+       ELSE
+          ratio = ratio_geom_below
+       ENDIF
+       ztmp(i+1)=ztmp(i)+ratio*(ztmp(i)-ztmp(i-1))
+    ENDDO
+    
+    ! Compute the depth of the lower interface of each layer.
+    !
+    zint(1) = depth_topthickness
+    DO i=2,nblayermax-1
+       zint(i) = (ztmp(i)+ztmp(i+1))/2.0
+    ENDDO
+    zint(nslm-1) = (znh(nslm-1) + znh(nslm))/2.0
+    zint(nslm) = (znh(nslm))
+    zint(nblayermax) = ztmp(nblayermax)+(ztmp(nblayermax)-ztmp(nblayermax-1))/2.0
+    
+    ! Determine the total number of layers for thermal (ngrnd).
+    !
+    imin=MINLOC(ABS(zint(:)-zmaxt))
+    ngrnd=imin(1)
+    ALLOCATE(znt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable znt','','')
+    ALLOCATE(dlt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable dlt','','')
+    ALLOCATE(zlt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable zlt','','')
+    
+    ! Assign values for znt, zlt, dlt
+    !
+    znt(:)=ztmp(1:ngrnd)
+    zlt(:) = zint(1:ngrnd)
+    dlt(1) = zint(1)
+    DO i=2,ngrnd
+       dlt(i) = zint(i)-zint(i-1)
+    ENDDO
+    ! Depth of layers for the hydrology are the same as for thermosoil but only the upper nslm layers are used
+    zlh(:) = zlt(1:nslm)
+    
+    ! Force the last thermal layer and node to be zmaxt
+    zlt(ngrnd) = zmaxt
+    dlt(ngrnd) = zmaxt-zint(ngrnd-1)
+
+
+
+
+    IF (printlev >=1) 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,*) "============================================================================="
+    END IF
+  END SUBROUTINE vertical_soil_init
+  
+END MODULE vertical_soil
Index: /branches/publications/ORCHIDEE-AFP/src_parameters/vertical_soil_var.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_parameters/vertical_soil_var.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_parameters/vertical_soil_var.f90	(revision 8430)
@@ -0,0 +1,63 @@
+! =================================================================================================================================
+! MODULE       : vertical_soil_var
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION: 
+!!                
+!! RECENT CHANGE(S):
+!!
+!! REFERENCE(S)	: 
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE vertical_soil_var
+
+  USE defprec
+
+  IMPLICIT NONE
+  PUBLIC
+
+  !! Dimensioning parameters
+  INTEGER(i_std), SAVE      :: ngrnd     !! Number of soil layer for thermo (unitless)
+!$OMP THREADPRIVATE(ngrnd)
+  INTEGER(i_std), SAVE      :: nslm      !! Number of levels in CWRR (unitless)
+!$OMP THREADPRIVATE(nslm)
+  REAL(r_std), SAVE         :: zmaxh     !! Maximum depth of soil reservoir in hydrol (m). Old name dpu_max or depth_Wmax
+!$OMP THREADPRIVATE(zmaxh)
+  REAL(r_std), SAVE         :: zmaxt     !! Maximum depth of the soil thermodynamics (m)
+!$OMP THREADPRIVATE(zmaxt)
+
+  !! Variables defining the vertical layering in soil moisture and temperature
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: znt          !! Depth of nodes for thermal (m) 
+!$OMP THREADPRIVATE(znt)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: znh          !! Depth of nodes for hydrology (m)
+!$OMP THREADPRIVATE(znh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dnh          !! Distance between the current node and the one above for hydrology (m)
+!$OMP THREADPRIVATE(dnh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dlh          !! Soil layer thickness for hydrology (m) 
+!$OMP THREADPRIVATE(dlh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dlt          !! Soil layer thickness for thermal (m)
+!$OMP THREADPRIVATE(dlt)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: zlh          !! Depth of lower layer-interface for hydrology (m)
+!$OMP THREADPRIVATE(zlh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: zlt          !! Depth of lower layer-interface for thermal (m)
+!$OMP THREADPRIVATE(zlt)
+
+  REAL(r_std),ALLOCATABLE, DIMENSION(:),SAVE :: diaglev        !! The lower limit of the layer on which soil moisture
+                                                               !! (relative) and temperature are going to be diagnosed.
+                                                               !! These variables are made for transfering the information
+                                                               !! to the biogeophyical processes modelled in STOMATE. 
+!$OMP THREADPRIVATE(diaglev)
+
+END MODULE vertical_soil_var
Index: /branches/publications/ORCHIDEE-AFP/src_sechiba/AA_make
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/AA_make	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/AA_make	(revision 8430)
@@ -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-AFP/src_sechiba/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/AA_make.ldef	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/AA_make.ldef	(revision 8430)
@@ -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-AFP/src_sechiba/chemistry.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/chemistry.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/chemistry.f90	(revision 8430)
@@ -0,0 +1,1914 @@
+! ================================================================================================================================
+!  MODULE       : chemistry
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   
+!!
+!!\n DESCRIPTION: 
+!!
+!! RECENT CHANGE(S): The content of this module were previously part of the diffuco module.
+!!                   ok_inca changed name into ok_bvoc and DIFFUCO_OK_INCA changed into CHEMISTRY_BVOC
+!!                   LEAFAGE_OK_INCA changed name into CHEMISTRY_LEAFAGE
+!!
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE chemistry
+
+  USE ioipsl
+  USE constantes
+  USE qsat_moisture
+  USE sechiba_io_p
+  USE ioipsl
+  USE pft_parameters
+  USE grid
+  USE time, ONLY : one_day, dt_sechiba, julian_diff, one_hour, one_year
+  USE ioipsl_para 
+  USE xios_orchidee
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: chemistry_xios_initialize, 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_xios_initialize
+!!
+!>\BRIEF	  Initialize xios dependant defintion before closing context defintion
+!!
+!! DESCRIPTION:	  Initialize xios dependant defintion before closing context defintion
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE chemistry_xios_initialize
+
+    CHARACTER(LEN=255) :: filename, name
+      
+
+    !! 1. Treat the file for fertilzation needed for option ok_cropsfertil_Nox
+
+    ! Read the input file name from run.def
+    filename = 'orchidee_fertilizer_1995.nc'
+    CALL getin_p('N_FERTIL_FILE',filename) 
+
+    ! Remove suffix .nc from filename
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    CALL xios_orchidee_set_file_attr("fertilizer_file",name=name)
+
+    ! Check if the file will be read by XIOS, by IOIPSL or not at all
+    IF (xios_interpolation .AND. ok_cropsfertil_Nox) THEN
+       IF (printlev>=2) WRITE (numout,*) 'The fertilizer file will be read later by XIOS'
+    ELSE
+       IF (ok_cropsfertil_Nox) THEN
+          IF (printlev>=2) WRITE (numout,*) 'The fertilizer file will be read later by IOIPSL'
+       ELSE
+          IF (printlev>=2) WRITE (numout,*) 'The fertilizer file will not be read'
+       END IF
+
+       ! The fertilizer file will not be read by XIOS. Now deactivate it for XIOS.
+       CALL xios_orchidee_set_file_attr("fertilizer_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("N_qt_WRICE_year_interp",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("N_qt_OTHER_year_interp",enabled=.FALSE.)
+    END IF
+
+
+    !! 2. Treat the file for bbg fertil needed for option ok_bbgfertil_Nox
+
+    ! Read the input file name from run.def
+    filename = 'orchidee_bbg_clim.nc'
+    CALL getin_p('CO2_BBG_FILE',filename)
+
+    ! Remove suffix .nc from filename
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    CALL xios_orchidee_set_file_attr("bbg_clim_file",name=name)
+
+    ! Check if the file will be read by XIOS, by IOIPSL or not at all
+    IF (xios_interpolation .AND. ok_bbgfertil_Nox) THEN
+       IF (printlev>=2) WRITE (numout,*) 'The bbgfertil file will be read later by XIOS'
+    ELSE
+       IF (ok_bbgfertil_Nox) THEN
+          IF (printlev>=2) WRITE (numout,*) 'The bbgfertil file will be read later by IOIPSL'
+       ELSE
+          IF (printlev>=2) WRITE (numout,*) 'The bbgfertil file will not be read'
+       END IF
+
+       ! This file will not be read by XIOS. Now deactivate it for XIOS.
+       CALL xios_orchidee_set_file_attr("bbg_clim_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("flx_co2_bbg_year_interp",enabled=.FALSE.)
+    END IF
+
+
+  END SUBROUTINE chemistry_xios_initialize
+
+!! ================================================================================================================================
+!! 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','','')
+       
+       IF (grid_type==unstructured) THEN
+          area2(:)=area(:)
+       ELSE  
+         area2(:) = resolution(:,1)*resolution(:,2) 
+       ENDIF
+       
+       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) 
+
+       IF ( xios_interpolation ) THEN
+    
+         CALL xios_orchidee_recv_field('N_qt_WRICE_year_interp',N_qt_WRICE_year)
+         CALL xios_orchidee_recv_field('N_qt_OTHER_year_interp',N_qt_OTHER_year)    
+
+         achem_wrice(:)=1
+         achem_other(:)=1
+       ELSE
+       
+         !! 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'
+         IF (printlev >= 1) WRITE(numout,*) "chemistry_initialize: Read and interpolate file " &
+              // TRIM(filename) //" for variable 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'
+         IF (printlev >= 1) WRITE(numout,*) "chemistry_initialize: Read and interpolate file " &
+              // TRIM(filename) //" for variable 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   
+    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)
+
+       IF (xios_interpolation) THEN
+    
+         CALL xios_orchidee_recv_field('flx_co2_bbg_year_interp',flx_co2_bbg_year)
+
+         achem_co2(:)=1
+       ELSE
+ 
+         !! 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'
+         IF (printlev >= 1) WRITE(numout,*) "chemistry_initialize: Read and interpolate file " &
+              // TRIM(filename) //" for variable 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
+    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)
+      CALL xios_orchidee_send_field("interp_diag_N_qt_WRICE_year",N_qt_WRICE_year)
+      CALL xios_orchidee_send_field("interp_diag_N_qt_OTHER_year",N_qt_OTHER_year)
+
+    END IF
+    IF (ok_bbgfertil_NOx) THEN
+      CALL xios_orchidee_send_field("achem_co2",achem_co2)
+      CALL xios_orchidee_send_field("interp_diag_flx_co2_bbg_year",flx_co2_bbg_year)
+    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, lai, &
+       frac_age, lalo, ccanopy, cim,  wind, snow, &
+       veget, hist_id, hist2_id,kjit, index, &
+       indexlai, indexveg)
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex         !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std), INTENT(in)                                 :: kjit             !! Time step number (-) 
+    INTEGER(i_std),INTENT (in)                                 :: hist_id          !! History file identifier (-)
+    INTEGER(i_std),INTENT (in)                                 :: hist2_id         !! History file 2 identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)           :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in)  :: indexlai         !! Indeces of the points on the 3D map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in)       :: indexveg         !! Indeces of the points on the 3D map (-)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: swdown           !! Down-welling surface short-wave flux 
+                                                                                   !! (W.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: coszang          !! Cosine of the solar zenith angle (unitless) 
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: temp_air         !! Air temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: temp_sol         !! Skin temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: ptnlev1          !! 1st level of soil temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: precip_rain      !! Rain precipitation !!?? init
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: humrel           !! Soil moisture stress (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: veget_max        !! Max. vegetation fraction (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)              :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: veget            !! Fraction of vegetation type (-)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: lai              !! Leaf area index (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm,nleafages), INTENT(in) :: frac_age         !! Age efficacity from STOMATE for iso 
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in)             :: lalo             !! Geographical coordinates for pixels (degrees)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)              :: ccanopy          !! CO2 concentration inside the canopy
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: cim              !! Intercellular CO2 over nlai 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)              :: wind             !! Wind module (m s^{-1})
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables 
+
+    INTEGER(i_std)                             :: ji, jv, jf, jl    !! Indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: fol_dens          !! foliar density (gDM.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)           :: tleaf             !! Foliar temperature (K)
+    REAL(r_std), DIMENSION(kjpindex)           :: t_no              !! Temperature used for soil NO emissions (C)
+    REAL(r_std), DIMENSION(kjpindex)           :: exp_1             !! First exponential used in the calculation of 
+                                                                    !! isoprene dependancy to Temperature 
+    REAL(r_std), DIMENSION(kjpindex)           :: exp_2             !! Second exponential used in the calculation of 
+                                                                    !! Isoprene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_iso            !! Isoprene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Cl_iso            !! Isoprene dependancy to Light 
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_mono           !! Monoterpene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_sesq           !! Sesquiterpenes dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_meth           !! Methanol dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_acet           !! Acetone dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_oxyVOC         !! Other oxygenated BVOC dependancy to Temperature
+    REAL(r_std)                                :: GAMMA_iso         !! Temperature and light dependancy for isoprene and fo each PFT
+    REAL(r_std)                                :: GAMMA_iso_m       !! Temperature and light dependancy for isoprene and fo each PFT for multilayer
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_mono          !! Total Temperature and light dependancy for monoterpenes
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_sesq          !! Total Temperature and light dependancy for sesquiterpens
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_meth          !! Total Temperature and light dependancy for methanol
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_acet          !! Total Temperature and light dependancy for acetone
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_MBO            !! MBO dependance to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Cl_MBO            !! MBO dependance to Light
+    REAL(r_std), DIMENSION(kjpindex)           :: Xvar              !! Parameter used in the calculation 
+                                                                    !! of MBO dependance to Temperature
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: flx_OVOC          !! Biogenic OVOC emission - 
+                                                                    !! Other Volatil Organic Components (kgC.m^{-2}.s^{-1})
+    !!Canopy radiative transfer model
+    REAL(r_std), DIMENSION(kjpindex)           :: So                !! Maximum radiation at the Earth surface (W.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)           :: Rfrac             !! Parameter in the regression of diffuse 
+                                                                    !! share on transmission
+    REAL(r_std), DIMENSION(kjpindex)           :: Kfrac             !! Parameter in the regression of diffuse 
+                                                                    !! share on transmission
+    REAL(r_std), DIMENSION(kjpindex)           :: swdf              !! Sw diffuse radiation (W.m^{-2}) 
+    REAL(r_std), DIMENSION(kjpindex)           :: swdr              !! Sw direct radiation (W.m^{-2}) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: PARscat           !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Clsun_iso         !! Isoprene dependance to light for sun leaves 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Clsh_iso          !! Isoprene dependance to light for shaded leaves
+    !! for multilayer canopy model for iso flux
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARscattab        !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nlai+1)             :: laitab            !! LAI per layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai)      :: laisuntabdep      !! LAI of sun leaves in each layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai)      :: laishtabdep       !! LAI of shaded leaves in each layer 
+                                                                    !! (m^2.m^{-2})
+    REAL(r_std)                                :: Clsun_iso_tab     !! Isoprene dependance to light 
+                                                                    !! for sun leaves and per layer 
+    REAL(r_std)                                :: Clsh_iso_tab      !! Isoprene dependance to light 
+                                                                    !! for shaded leaves and per layer
+    !for multilayer canopy model Spitter et al. 1986
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARnotscat        !! Not-Scattered PAR 
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARabsdir         !! Absorbed light of the PAR direct flux  
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARabsdiff        !! Absorbed light of the PAR diffuse flux  
+    REAL(r_std), PARAMETER                     :: sigma = 0.20      !! scattering coefficient of single leaves and for visible radiation
+    REAL(r_std), PARAMETER                     :: cluster = 0.85    !! clustering coefficient for leaves, the same that is setting for default in MEGAN V2.10
+    REAL(r_std)                                :: rho               !! reflection index of a green, closed vegetation
+    REAL(r_std)                                :: kbl               !! extinction coefficient of black leaves
+    REAL(r_std)                                :: kdf               !! extinction coefficient of diffuse flux
+    !!Leaf age
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_iso       !! Isoprene emission dependance to Leaf Age 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_meth      !! Methanol emission dependance to Leaf Age 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_VOC       !! Other VOC emission dependance to Leaf Age 
+    !!BBG and Fertilizers for NOx soil emission
+    REAL(r_std), DIMENSION(kjpindex)           :: veget_max_nowoody !! sum of veget_max for non-woody PFT
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: N_qt_WRICE_pft    !! N fertiliser on RICE 
+                                                                    !! (kgN per year per grid cell)
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: N_qt_OTHER_pft    !! N fertiliser on other veg 
+                                                                    !! (kgN per year per grid cell)
+    !! CO2 inhibition effect on isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm)       :: fco2_wshort       !! Wilkinson short term function for CO2 impact on BVOC (isoprene) 
+    REAL(r_std),DIMENSION (kjpindex)           :: fco2_wlong        !! Wilkinson long term function for CO2 impact on BVOC (isoprene) 
+    REAL(r_std)                                :: fco2_ctrl
+    REAL(r_std),DIMENSION (kjpindex,nvm)       :: fco2              !! Function for CO2 impact on BVOC (isoprene)
+    REAL(r_std), DIMENSION(kjpindex)           :: Ismax_short
+    REAL(r_std), DIMENSION(kjpindex)           :: h_short
+    REAL(r_std), DIMENSION(kjpindex)           :: Cstar_short
+    REAL(r_std)                                :: Ismax_long
+    REAL(r_std)                                :: h_long
+    REAL(r_std)                                :: Cstar_long
+
+    !! 0.5 Parameters values
+
+    REAL(r_std), PARAMETER :: CT1 = 95000.0       !! Empirical coeffcient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
+    REAL(r_std), PARAMETER :: CT2 = 230000.0      !! Empirical coefficient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
+    REAL(r_std), PARAMETER :: TS = 303.0          !! Leaf temperature at standard condition
+                                                  !! (see Guenther .et. al, 1995, eq(10)) (K)
+    REAL(r_std), PARAMETER :: TM = 314.0          !! Leaf temperature (see Guenther .et. al, 1995, eq(10)) (K)
+
+    REAL(r_std), PARAMETER :: alpha_ = 0.0027     !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
+    REAL(r_std), PARAMETER :: CL1 = 1.066         !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
+    REAL(r_std), PARAMETER :: beta = 0.09         !! Empirical coeffcient (see Guenther .et. al, 1995, eq(11)) (K^{-1})
+    REAL(r_std), PARAMETER :: lai_threshold = 11. !! Lai threshold for the calculation of scattered radiation
+                                                  !! based on Guenther .et. al (1995) (m^2.m^{-2})
+
+                                              
+    ! Biogenic emissions
+    REAL(r_std),DIMENSION(kjpindex)          :: PAR                !! Photosynthetic active radiation, half of swdown
+                                                                   !! @tex ($\mu mol photons. m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: PARsun             !! PAR received by sun leaves
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: PARsh              !! PAR received by shaded leaves 
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: laisun             !! Leaf area index of Sun leaves (m^2.m^{-2})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: laish              !! Leaf area index of Shaded leaves (m^2.m^{-2}) 
+
+    CHARACTER(LEN=14)                        :: tleafsun_name      !! To store variables names for I/O
+    CHARACTER(LEN=13)                        :: tleafsh_name       !! To store variables names for I/O
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)  :: Tleafsun_temp      !! temporary sunlit leaf temperature matrix for writing
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)  :: Tleafsh_temp       !! temporary shade leaf temperature matrix for writing
+    REAL(r_std),DIMENSION(kjpindex)          :: 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.        
+   
+
+    !! 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. ABS(coszang(ji)) .GT. min_sechiba) 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) .GT. min_sechiba)) .OR. &
+                  ((lalo(ji,1) .LT. -30.) .AND. (julian_diff .GE. 305. .OR. julian_diff .LE. 59.) .AND.&
+                  (veget_max(ji,jv) .GT. min_sechiba))) 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) .GT. min_sechiba)) 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 allow 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-AFP/src_sechiba/condveg.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/condveg.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/condveg.f90	(revision 8430)
@@ -0,0 +1,1765 @@
+! ===============================================================================================================================
+! MODULE       : condveg
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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.
+!!
+!! 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 grid
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: condveg_xios_initialize, condveg_main, condveg_initialize, condveg_finalize, condveg_clear 
+
+  !
+  ! Variables used inside condveg module
+  !
+  LOGICAL, SAVE                     :: l_first_condveg=.TRUE.           !! To keep first call's trace
+!$OMP THREADPRIVATE(l_first_condveg)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_dry(:,:)                 !! Albedo values for the dry bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_dry)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_wet(:,:)                 !! Albedo values for the wet bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_wet)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_moy(:,:)                 !! Albedo values for the mean bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_moy)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_bg(:,:)                  !! Albedo values for the background bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_bg)
+  INTEGER, SAVE                     :: printlev_loc                     !! Output debug level
+!$OMP THREADPRIVATE(printlev_loc)
+  
+CONTAINS
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE:    condveg_xios_initialize
+  !!
+  !>\BRIEF	  Initialize xios dependant defintion before closing context defintion
+  !!
+  !! DESCRIPTION:	  Initialize xios dependant defintion needed for the interpolations done in condveg.
+  !!                      Reading is deactivated if the sechiba restart file exists because the variable
+  !!                      should be in the restart file already.
+  !!                      This subruting is called before closing context with xios_orchidee_close_definition in intersurf 
+  !!                      via the subroutine sechiba_xios_initialize. 
+  !!
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE condveg_xios_initialize
+    
+    CHARACTER(LEN=255)   :: filename        !! Filename read from run.def
+    CHARACTER(LEN=255)   :: name            !! Filename without suffix .nc
+    LOGICAL              :: lerr            !! Flag to dectect error
+     
+ 
+    ! Read the file name for the albedo input file from run.def
+    filename = 'alb_bg.nc'
+    CALL getin_p('ALB_BG_FILE',filename)
+
+    ! Remove suffix .nc from filename
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    
+    ! Define the file name in XIOS
+    CALL xios_orchidee_set_file_attr("albedo_file",name=name)
+
+    ! Define default values for albedo
+    lerr=xios_orchidee_setvar('albbg_vis_default',0.129)
+    lerr=xios_orchidee_setvar('albbg_nir_default',0.247)
+
+    ! Check if the albedo file will be read by XIOS, by IOIPSL or not at all
+    IF (xios_interpolation .AND. alb_bg_modis .AND. restname_in=='NONE') THEN
+       ! The albedo file will be read using XIOS
+       IF (printlev>=2) WRITE(numout,*) 'Reading of albedo file will be done later using XIOS. The filename is ', filename
+
+    ELSE
+       IF (.NOT. alb_bg_modis) THEN
+          IF (printlev>=2) WRITE (numout,*) 'No reading of albedo will be done because alb_bg_modis=FALSE'
+       ELSE IF (restname_in=='NONE') THEN
+          IF (printlev>=2) WRITE (numout,*) 'The albedo file will be read later by IOIPSL'
+       ELSE
+          IF (printlev>=2) WRITE (numout,*) 'The albedo file will not be read because the restart file exists.'
+       END IF
+
+       ! The albedo file will not be read by XIOS. Now deactivate albedo for XIOS.
+       CALL xios_orchidee_set_file_attr("albedo_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("bg_alb_vis_interp",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("bg_alb_nir_interp",enabled=.FALSE.)
+    END IF
+
+  END SUBROUTINE condveg_xios_initialize
+
+
+  !!  =============================================================================================================================
+  !! 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, lai, &
+       emis, albedo, z0m, z0h, roughheight, &
+       frac_snow_veg,frac_snow_nobio)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables  
+    INTEGER(i_std), INTENT(in)                       :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                       :: rest_id          !! _Restart_ file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index            !! Indeces of the points on the map
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,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), 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,nvm), INTENT(in) :: lai              !! Leaf area index (m2[leaf]/m2[ground])
+
+    !! 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
+
+    !! 0.4 Local variables   
+    INTEGER                                          :: ier
+    REAL(r_std), DIMENSION(kjpindex,2)               :: albedo_snow      !! Snow albedo for visible and near-infrared range(unitless)
+    REAL(r_std), DIMENSION(kjpindex,2)               :: alb_bare         !! Mean bare soil albedo for visible and near-infrared 
+                                                                         !! range (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,2)               :: alb_veget        !! Mean vegetation albedo for visible and near-infrared 
+!                                                                        !! range (unitless) 
+!_ ================================================================================================================================
+  
+    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'
+
+    !! 1. Allocate module variables and read from restart or initialize
+    
+    IF (alb_bg_modis) THEN
+       ! Allocate background soil albedo
+       ALLOCATE (soilalb_bg(kjpindex,2),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_bg','','')
+       
+       ! 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., soilalb_bg, "gather", nbp_glo, index_g)
+
+       ! Initialize by interpolating from file if the variable was not in restart file
+       IF ( ALL(soilalb_bg(:,:) == val_exp) ) THEN
+          CALL condveg_background_soilalb(kjpindex, lalo, neighbours, resolution, contfrac)
+       END IF
+       CALL xios_orchidee_send_field("soilalb_bg",soilalb_bg)
+
+    ELSE
+       ! Allocate
+       ! Dry soil albedo
+       ALLOCATE (soilalb_dry(kjpindex,2),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_dry','','')
+       
+       ! Wet soil albedo
+       ALLOCATE (soilalb_wet(kjpindex,2),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_wet','','')
+       
+       ! Mean soil albedo
+       ALLOCATE (soilalb_moy(kjpindex,2),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_moy','','')
+       
+       ! Read variables from restart file
+       ! 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
+    END IF
+
+    ! 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_nobio, snowrho, snowdz, &
+                           frac_snow_veg, frac_snow_nobio)
+
+    !! 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, frac_snow_veg, z0m, z0h, roughheight)
+          ENDIF
+       END IF
+    END IF
+
+    !! 5. Calculate albedo
+    CALL condveg_albedo (kjpindex,       veget,         veget_max,     drysoil_frac, frac_nobio,     &
+                         totfrac_nobio,  snow,          snow_age,      snow_nobio,     &
+                         snow_nobio_age, snowdz,        snowrho,                       &
+                         tot_bare_soil,  frac_snow_veg, frac_snow_nobio,               &
+                         albedo,         albedo_snow,   alb_bare,     alb_veget)
+         
+    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, lai, &
+       emis, albedo, z0m, z0h, roughheight, &
+       frac_snow_veg, frac_snow_nobio )
+
+     !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables  
+
+    INTEGER(i_std), INTENT(in)                       :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                       :: rest_id          !! _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                       :: hist_id          !! _History_ file identifier
+    INTEGER(i_std), OPTIONAL, INTENT (in)            :: hist2_id          !! _History_ file 2 identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index            !! Indeces of the points on the map
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,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), 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,nvm), INTENT(in) :: lai              !! Leaf area index (m2[leaf]/m2[ground])
+
+    !! 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
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables   
+    REAL(r_std), DIMENSION(kjpindex,2)               :: albedo_snow      !! Snow albedo (unitless ratio)     
+    REAL(r_std), DIMENSION(kjpindex)                 :: albedo_snow_mean !! Mean snow albedo over all wave length, for diag (unitless ratio)     
+    REAL(r_std), DIMENSION(kjpindex,2)               :: alb_bare         !! Mean bare soil albedo for visible and near-infrared 
+                                                                         !! range (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,2)               :: alb_veget        !! Mean vegetation albedo for visible and near-infrared 
+                                                                         !! range (unitless) 
+    INTEGER(i_std)                                   :: ji
+!_ ================================================================================================================================
+  
+    !! 1. Calculate the fraction of snow on vegetation and nobio
+    CALL condveg_frac_snow(kjpindex, snow_nobio, snowrho, snowdz, &
+                           frac_snow_veg, frac_snow_nobio)
+
+    !! 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, frac_snow_veg, z0m, z0h, roughheight)
+       ENDIF
+     
+    ENDIF
+
+
+    !! 4. Calculate albedo
+    CALL condveg_albedo (kjpindex,       veget,         veget_max,     drysoil_frac, frac_nobio,     &
+                         totfrac_nobio,  snow,          snow_age,      snow_nobio,     &
+                         snow_nobio_age, snowdz,        snowrho,                       &
+                         tot_bare_soil,  frac_snow_veg, frac_snow_nobio,               &
+                         albedo,         albedo_snow,   alb_bare,      alb_veget)
+         
+
+
+    !! 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))
+       CALL xios_orchidee_send_field("vegalb_vis",alb_veget(:,1))
+       CALL xios_orchidee_send_field("vegalb_nir",alb_veget(:,2))
+    END IF
+    CALL xios_orchidee_send_field("albedo_vis",albedo(:,1))
+    CALL xios_orchidee_send_field("albedo_nir",albedo(:,2))
+
+    ! Calculcate albedo_snow mean over wave length, setting xios_default_val when there is no snow    
+    DO ji=1,kjpindex
+       IF (snow(ji) > 0) THEN
+          albedo_snow_mean(ji) = (albedo_snow(ji,1) + albedo_snow(ji,2))/2
+       ELSE
+          albedo_snow_mean(ji) = xios_default_val
+       END IF
+    END DO
+    CALL xios_orchidee_send_field("albedo_snow", albedo_snow_mean)
+    
+    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(:,1) + albedo_snow(:,2))/2, 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(:,1) + albedo_snow(:,2))/2, kjpindex, index)
+       ENDIF
+    ELSE
+       IF (.NOT. impaze) THEN
+          CALL histwrite_p(hist_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+          CALL histwrite_p(hist_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+          CALL histwrite_p(hist_id, 'vegalb_vis',  kjit, alb_veget(:,1), kjpindex, index)
+          CALL histwrite_p(hist_id, 'vegalb_nir',  kjit, alb_veget(:,2), kjpindex, index)
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite_p(hist2_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'vegalb_vis',  kjit, alb_veget(:,1), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'vegalb_nir',  kjit, alb_veget(:,2), kjpindex, index)
+          ENDIF
+       END IF
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*)' condveg_main done '
+
+  END SUBROUTINE condveg_main
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : condveg_finalize
+  !!
+  !>\BRIEF                                    Write to restart file
+  !!
+  !! DESCRIPTION			    : This subroutine writes the module variables and variables calculated in condveg
+  !!                                          to restart file
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! REFERENCE(S)			    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE condveg_finalize (kjit, kjpindex, rest_id, 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)     
+    
+    !_ ================================================================================================================================
+    
+    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)
+    
+    IF ( alb_bg_modis ) THEN
+       CALL restput_p (rest_id, 'soilalbedo_bg', nbp_glo, 2, 1, kjit, soilalb_bg, 'scatter',  nbp_glo, index_g)
+    ELSE
+       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)
+    END IF
+  END SUBROUTINE condveg_finalize
+
+!! ==============================================================================================================================
+!! SUBROUTINE 	: condveg_clear
+!!
+!>\BRIEF        Deallocate albedo variables
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_clear  ()
+
+      l_first_condveg=.TRUE.
+       
+      ! Dry soil albedo
+       IF (ALLOCATED (soilalb_dry)) DEALLOCATE (soilalb_dry)
+       ! Wet soil albedo
+       IF (ALLOCATED(soilalb_wet))  DEALLOCATE (soilalb_wet)
+       ! Mean soil albedo
+       IF (ALLOCATED(soilalb_moy))  DEALLOCATE (soilalb_moy)
+       ! BG soil albedo
+       IF (ALLOCATED(soilalb_bg))  DEALLOCATE (soilalb_bg)
+
+  END SUBROUTINE condveg_clear
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE   : condveg_albedo
+!!
+!>\BRIEF        Calculate albedo
+!!
+!! DESCRIPTION  : The albedo is calculated for both the visible and near-infrared 
+!! domain. First the mean albedo of the bare soil is calculated. Two options exist: 
+!! either the soil albedo depends on soil wetness (drysoil_frac variable), or the soil albedo 
+!! is set to a mean soil albedo value.
+!! The snow albedo scheme presented below belongs to prognostic albedo 
+!! category, i.e. the snow albedo value at a time step depends on the snow albedo value 
+!! at the previous time step.
+!!
+!! First, the following formula (described in Chalita and Treut 1994) is used to describe 
+!! the change in snow albedo with snow age on each PFT and each non-vegetative surfaces, 
+!! i.e. continental ice, lakes, etc.: \n 
+!! \latexonly 
+!! \input{SnowAlbedo.tex}
+!! \endlatexonly
+!! \n
+!! Where snowAge is snow age, tcstSnowa is a critical aging time (tcstSnowa=5 days)
+!! snowaIni and snowaIni+snowaDec corresponds to albedos measured for aged and
+!! fresh snow respectively, and their values for each PFT and each non-vegetative surfaces 
+!! is precribed in in constantes_veg.f90.\n
+!! In order to estimate gridbox snow albedo, snow albedo values for each PFT and 
+!! each  non-vegetative surfaces with a grid box are weightedly summed up by their 
+!! respective fractions.\n
+!! Secondly, the snow cover fraction is computed as:
+!! \latexonly 
+!! \input{SnowFraction.tex}
+!! \endlatexonly
+!! \n
+!! Where fracSnow is the fraction of snow on total vegetative or total non-vegetative
+!! surfaces, snow is snow mass (kg/m^2) on total vegetated or total nobio surfaces.\n 
+!! Finally, the surface albedo is then updated as the weighted sum of fracSnow, total
+!! vegetated fraction, total nobio fraction, gridbox snow albedo, and previous
+!! time step surface albedo.
+!!
+!! RECENT CHANGE(S): These calculations were previously done in condveg_albcalc and condveg_snow
+!!
+!! MAIN OUTPUT VARIABLE(S): :: albedo; surface albedo. :: albedo_snow; snow
+!! albedo
+!!
+!! REFERENCE(S) :  
+!! Chalita, S. and H Le Treut (1994), The albedo of temperate and boreal forest and 
+!!  the Northern Hemisphere climate: a sensitivity experiment using the LMD GCM,
+!!  Climate Dynamics, 10 231-240.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_albedo  (kjpindex,       veget,         veget_max,     drysoil_frac, frac_nobio,       &
+                              totfrac_nobio,  snow,          snow_age,      snow_nobio,       &
+                              snow_nobio_age, snowdz,        snowrho,                         &
+                              tot_bare_soil,  frac_snow_veg, frac_snow_nobio,                 &
+                              albedo,         albedo_snow,   alb_bare,   alb_veget)
+
+
+    !! 0. Variable and parameter declarations
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex        !! Domain size - Number of land pixels  (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget           !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                           !! (m^2 m^{-2})   
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget_max
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: drysoil_frac    !! Fraction of visibly Dry soil(between 0 and 1)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio      !! Fraction of non-vegetative surfaces, i.e. 
+                                                                           !! continental ice, lakes, etc. (unitless)     
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: totfrac_nobio   !! Total fraction of non-vegetative surfaces, i.e. 
+                                                                           !! continental ice, lakes, etc. (unitless)   
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: snow            !! Snow mass in vegetation (kg m^{-2})           
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio      !! Snow mass on continental ice, lakes, etc. (kg m^{-2})      
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: snow_age        !! Snow age (days)        
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio_age  !! Snow age on continental ice, lakes, etc. (days)    
+    REAL(r_std),DIMENSION (kjpindex,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)        :: frac_snow_veg   !! Fraction of snow on vegetation (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(in) :: frac_snow_nobio !! Fraction of snow on continental ice, lakes, etc. (unitless ratio) 
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)    :: albedo          !! Albedo (unitless ratio)          
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)    :: albedo_snow     !! Snow albedo (unitless ratio)     
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(out)     :: alb_bare        !! Mean bare soil albedo for visible and near-infrared 
+                                                                           !! range (unitless). Only calculated for .NOT. impaze
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(out)     :: alb_veget       !! Mean vegetation albedo for visible and near-infrared 
+                                                                           !! range (unitless). Only calculated for .NOT. impaze
+
+    !! 0.3 Local variables
+    INTEGER(i_std)                                      :: ji, jv, jb,ks   !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex,2)                  :: snowa_veg       !! Albedo of snow covered area on vegetation
+                                                                           !! (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex,nnobio,2)           :: snowa_nobio     !! Albedo of snow covered area on continental ice, 
+                                                                           !! lakes, etc. (unitless ratio)     
+    REAL(r_std), DIMENSION(kjpindex)                    :: fraction_veg    !! Total vegetation fraction (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex)                    :: agefunc_veg     !! Age dependency of snow albedo on vegetation 
+                                                                           !! (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nnobio)             :: agefunc_nobio   !! Age dependency of snow albedo on ice, 
+                                                                           !! lakes, .. (unitless)
+    REAL(r_std)                                         :: alb_nobio       !! Albedo of continental ice, lakes, etc. 
+                                                                           !!(unitless ratio)
+    REAL(r_std),DIMENSION (nvm,2)                       :: alb_leaf_tmp    !! Variables for albedo values for all PFTs and 
+    REAL(r_std),DIMENSION (nvm,2)                       :: snowa_aged_tmp  !! spectral domains (unitless) 
+    REAL(r_std),DIMENSION (nvm,2)                       :: snowa_dec_tmp
+!_ ================================================================================================================================
+
+
+
+    !! 1. Preliminary calculation without considering snow
+    snowa_aged_tmp(:,ivis) = snowa_aged_vis(:)
+    snowa_aged_tmp(:,inir) = snowa_aged_nir(:)
+    snowa_dec_tmp(:,ivis) = snowa_dec_vis(:)
+    snowa_dec_tmp(:,inir) = snowa_dec_nir(:)
+
+    IF ( impaze ) THEN
+       !! No caluculation, set default value
+       albedo(:,ivis) = albedo_scal(ivis)
+       albedo(:,inir) = albedo_scal(inir)
+
+       ! These variables are needed for snow albedo and for diagnostic output
+       alb_veget(:,ivis) = albedo_scal(ivis)
+       alb_veget(:,inir) = albedo_scal(inir)
+       alb_bare(:,ivis) = albedo_scal(ivis)
+       alb_bare(:,inir) = albedo_scal(inir)
+    ELSE
+       !! Preliminary calculation without considering snow (previously done in condveg_albcalc)    
+       ! Assign values of leaf and snow albedo for visible and near-infrared range
+       ! to local variable (constantes_veg.f90)
+       alb_leaf_tmp(:,ivis) = alb_leaf_vis(:)
+       alb_leaf_tmp(:,inir) = alb_leaf_nir(:)
+       
+       !! 1.1 Calculation and assignment of soil albedo
+       
+       DO ks = 1, 2! Loop over # of spectra
+          
+          ! If alb_bg_modis=TRUE, the background soil albedo map for the current simulated month is used
+          ! If alb_bg_modis=FALSE and alb_bare_model=TRUE, the soil albedo calculation depends on soil moisture
+          ! If alb_bg_modis=FALSE and alb_bare_model=FALSE, the mean soil albedo is used without the dependance on soil moisture
+          ! see subroutines 'condveg_soilalb' and 'condveg_background_soilalb'
+          IF ( alb_bg_modis ) THEN
+             alb_bare(:,ks) = soilalb_bg(:,ks)
+          ELSE
+             IF ( alb_bare_model ) THEN
+                alb_bare(:,ks) = soilalb_wet(:,ks) + drysoil_frac(:) * (soilalb_dry(:,ks) -  soilalb_wet(:,ks))
+             ELSE
+                alb_bare(:,ks) = soilalb_moy(:,ks)
+             ENDIF
+          ENDIF
+          
+          ! Soil albedo is weighed by fraction of bare soil          
+          albedo(:,ks) = tot_bare_soil(:) * alb_bare(:,ks)
+          
+          !! 1.2 Calculation of mean albedo of over the grid cell 
+          
+          ! Calculation of mean albedo of over the grid cell and
+          !    mean albedo of only vegetative PFTs over the grid cell
+          alb_veget(:,ks) = zero
+          
+          DO jv = 2, nvm  ! Loop over # of PFTs
+             
+             ! Mean albedo of grid cell for visible and near-infrared range
+             albedo(:,ks) = albedo(:,ks) + veget(:,jv)*alb_leaf_tmp(jv,ks)
+             
+             ! Mean albedo of vegetation for visible and near-infrared range
+             alb_veget(:,ks) = alb_veget(:,ks) + veget(:,jv)*alb_leaf_tmp(jv,ks)
+          ENDDO ! Loop over # of PFTs
+          
+       ENDDO
+    END IF
+
+
+    !! 2. Calculate snow albedos on both total vegetated and total nobio surfaces
+ 
+    ! The snow albedo could be either prescribed (in condveg_init.f90) or 
+    !  calculated following Chalita and Treut (1994).
+    ! Check if the precribed value fixed_snow_albedo exists
+    IF (ABS(fixed_snow_albedo - undef_sechiba) .GT. EPSILON(undef_sechiba)) THEN
+       snowa_veg(:,:) = fixed_snow_albedo
+       snowa_nobio(:,:,:) = fixed_snow_albedo
+       fraction_veg(:) = un - totfrac_nobio(:)
+    ELSE ! calculated following Chalita and Treut (1994)
+       
+       !! 2.1 Calculate age dependence
+       
+       ! On vegetated surfaces
+       DO ji = 1, kjpindex
+          agefunc_veg(ji) = EXP(-snow_age(ji)/tcst_snowa)
+       ENDDO
+       
+       ! On non-vegtative surfaces
+       DO jv = 1, nnobio ! Loop over # nobio types
+          DO ji = 1, kjpindex
+             agefunc_nobio(ji,jv) = EXP(-snow_nobio_age(ji,jv)/tcst_snowa)
+          ENDDO
+       ENDDO
+       
+       !! 2.1 Calculate snow albedo 
+       ! For vegetated surfaces
+       fraction_veg(:) = un - totfrac_nobio(:)
+       snowa_veg(:,:) = zero
+       ! Alternative formulation based on veget and not veget_max that needs to be tested
+       ! See ticket 223
+!!$          DO jb = 1, 2
+!!$             DO ji = 1, kjpindex
+!!$                IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+!!$                   snowa_veg(ji,jb) = snowa_veg(ji,jb) + &
+!!$                        tot_bare_soil(ji)/fraction_veg(ji) * ( snowa_aged_tmp(1,jb)+snowa_dec_tmp(1,jb)*agefunc_veg(ji) )
+!!$                END IF
+!!$             END DO
+!!$          END DO
+!!$          
+!!$          DO jb = 1, 2
+!!$             DO jv = 2, nvm
+!!$                DO ji = 1, kjpindex
+!!$                   IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+!!$                      snowa_veg(ji,jb) = snowa_veg(ji,jb) + &
+!!$                           veget(ji,jv)/fraction_veg(ji) * ( snowa_aged_tmp(jv,jb)+snowa_dec_tmp(jv,jb)*agefunc_veg(ji) )
+!!$                   ENDIF
+!!$                ENDDO
+!!$             ENDDO
+!!$          ENDDO
+       DO jb = 1, 2
+          DO jv = 1, nvm
+             DO ji = 1, kjpindex
+                IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+                   snowa_veg(ji,jb) = snowa_veg(ji,jb) + &
+                        veget_max(ji,jv)/fraction_veg(ji) * ( snowa_aged_tmp(jv,jb)+snowa_dec_tmp(jv,jb)*agefunc_veg(ji) )
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+
+       !
+       ! snow albedo on other surfaces
+       !
+       DO jb = 1, 2
+          DO jv = 1, nnobio
+             DO ji = 1, kjpindex
+                snowa_nobio(ji,jv,jb) = ( snowa_aged_tmp(1,jb) + snowa_dec_tmp(1,jb) * agefunc_nobio(ji,jv) ) 
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+    
+    !! 3. Update surface albedo
+    
+    ! Update surface albedo using the weighted sum of previous time step surface albedo,
+    ! total vegetated fraction, total nobio fraction, snow cover fraction (both vegetated and 
+    ! non-vegetative surfaces), and snow albedo (both vegetated and non-vegetative surfaces). 
+    ! Although both visible and near-infrared surface albedo are presented, their calculations 
+    ! are the same.
+    DO jb = 1, 2
+
+       albedo(:,jb) = ( fraction_veg(:) ) * &
+            ( (un-frac_snow_veg(:)) * albedo(:,jb) + &
+            ( frac_snow_veg(:)  ) * snowa_veg(:,jb)    )
+       DO jv = 1, nnobio ! Loop over # nobio surfaces
+          
+          IF ( jv .EQ. iice ) THEN
+             alb_nobio = alb_ice(jb)
+          ELSE
+             WRITE(numout,*) 'jv=',jv
+             WRITE(numout,*) 'DO NOT KNOW ALBEDO OF THIS SURFACE TYPE'
+             CALL ipslerr_p(3,'condveg_snow','DO NOT KNOW ALBEDO OF THIS SURFACE TYPE','','')
+          ENDIF
+          
+          albedo(:,jb) = albedo(:,jb) + &
+               ( frac_nobio(:,jv) ) * &
+               ( (un-frac_snow_nobio(:,jv)) * alb_nobio + &
+               ( frac_snow_nobio(:,jv)  ) * snowa_nobio(:,jv,jb)   )
+       ENDDO
+       
+    END DO
+    
+    ! Calculate snow albedo
+    DO jb = 1, 2
+       albedo_snow(:,jb) =  fraction_veg(:) * frac_snow_veg(:) * snowa_veg(:,jb)
+       DO jv = 1, nnobio 
+          albedo_snow(:,jb) = albedo_snow(:,jb) + &
+               frac_nobio(:,jv) * frac_snow_nobio(:,jv) * snowa_nobio(:,jv,jb)
+       ENDDO
+    ENDDO
+    
+    IF (printlev>=3) WRITE (numout,*) ' condveg_albedo done '
+    
+  END SUBROUTINE condveg_albedo
+
+
+  
+!! ==============================================================================================================================
+!! 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_nobio, snowrho, snowdz, &
+                               frac_snow_veg, frac_snow_nobio)
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                          :: kjpindex        !! Domain size
+    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
+
+    !! 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
+   
+    !! Calculate snow cover fraction for both total vegetated and total non-vegetative surfaces.
+    snowdepth=sum(snowdz,2)
+    snowrho_snowdz=sum(snowrho*snowdz,2)
+    WHERE(snowdepth(:) .LT. min_sechiba)
+       frac_snow_veg(:) = 0.
+    ELSEWHERE
+       snowrho_ave(:)=snowrho_snowdz(:)/snowdepth(:)
+       frac_snow_veg(:) = tanh(snowdepth(:)/(0.025*(snowrho_ave(:)/50.)))
+    END WHERE
+    
+    DO jv = 1, nnobio
+       frac_snow_nobio(:,jv) = MIN(MAX(snow_nobio(:,jv),zero)/(MAX(snow_nobio(:,jv),zero)+snowcri_alb*sn_dens/100.0),un)
+    ENDDO
+
+    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 >= 1) WRITE(numout,*) "condveg_soilalb: Read and 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 	: condveg_background_soilalb
+!!
+!>\BRIEF        This subroutine reads the albedo of bare soil
+!!
+!! DESCRIPTION  This subroutine reads the background albedo map in 0.5 x 0.5 deg resolution 
+!! derived from JRCTIP product to be used as bare soil albedo. These values are then interpolated
+!! to the model's resolution.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): soilalb_bg for visible and near-infrared range 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE condveg_background_soilalb(nbpt, lalo, neighbours, resolution, contfrac)
+
+    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    = ALB_BG_MODIS
+    !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)
+    
+    IF (xios_interpolation) THEN
+
+       ! Read and interpolation background albedo using XIOS
+       CALL xios_orchidee_recv_field('bg_alb_vis_interp',soilalb_bg(:,ivis))
+       CALL xios_orchidee_recv_field('bg_alb_nir_interp',soilalb_bg(:,inir))
+
+       aalb_bg(:)=1
+       
+    ELSE
+       ! Read background albedo file using IOIPSL and interpolate using aggregate standard method
+       
+       ALLOCATE(albbg_default(2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Pb in allocation for albbg_default','','')
+       
+       ! For this case there are not types/categories. We have 'only' a continuos 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,*) "condveg_background_soilalb: 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(ivis), albbg_norefinf,                         &
+            soilalb_bg(:,ivis), aalb_bg)
+       IF (printlev_loc >= 5) WRITE(numout,*)"  condveg_background_soilalb after InterpWeight2Dcont for '" //   &
+            TRIM(variablename) // "'"
+     
+       ! Interpolate variable bg_alb_nir in the same file
+       variablename = 'bg_alb_nir'
+       IF (printlev_loc >= 2) WRITE(numout,*) "condveg_background_soilalb: 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,                         &
+            soilalb_bg(:,inir), aalb_bg)
+       IF (printlev_loc >= 5) WRITE(numout,*)"  condveg_background_soilalb after InterpWeight2Dcont for '" //   &
+            TRIM(variablename) // "'"
+       
+       IF (ALLOCATED(albbg_default)) DEALLOCATE(albbg_default)
+       
+       IF (printlev_loc >= 3) WRITE(numout,*)'  condveg_background_soilalb ended'
+  
+    ENDIF
+  
+    CALL xios_orchidee_send_field("interp_diag_alb_vis",soilalb_bg(:,ivis))
+    CALL xios_orchidee_send_field("interp_diag_alb_nir",soilalb_bg(:,inir))
+    CALL xios_orchidee_send_field("aalb_bg",aalb_bg)
+    
+  END SUBROUTINE condveg_background_soilalb
+
+
+!! ==============================================================================================================================
+!! 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, 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)       :: tot_bare_soil !! Total evaporating bare soil fraction 
+    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)                    :: 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         !! Drag coefficient for momentum
+    REAL(r_std), DIMENSION(kjpindex)                    :: dragh         !! Drag coefficient for heat
+    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(:) = tot_bare_soil(:) * (ct_karman/LOG(ztmp(:)/z0_ground))**2
+    dragh(:) = tot_bare_soil(:) * (ct_karman/LOG(ztmp(:)/(z0_ground/ratio_z0m_z0h(1))))*(ct_karman/LOG(ztmp(:)/z0_ground))
+    ! 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_ground)))**2
+       dragh(:) = dragh(:) + d_veg(:) * (ct_karman/LOG(ztmp(:)/(MAX(height(:,jv)*z0_over_height(jv),z0_ground) / &
+            ratio_z0m_z0h(jv)))) * (ct_karman/LOG(ztmp(:)/MAX(height(:,jv)*z0_over_height(jv),z0_ground)))
+
+       ! 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. min_sechiba ) 
+       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
+       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         !! Drag coefficient for momentum
+    REAL(r_std), DIMENSION(kjpindex)                    :: dragh         !! Drag coefficient 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. min_sechiba ) 
+       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
+       ! Note that z0m could be made dependent of frac_snow_nobio
+       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-AFP/src_sechiba/diffuco.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/diffuco.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/diffuco.f90	(revision 8430)
@@ -0,0 +1,2752 @@
+! ================================================================================================================================
+!  MODULE       : diffuco
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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 constantes
+  USE constantes_soil
+  USE qsat_moisture
+  USE sechiba_io_p
+  USE ioipsl
+  USE pft_parameters
+  USE grid
+  USE time, ONLY : one_day, dt_sechiba
+  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
+  !
+  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        
+    !_ ================================================================================================================================
+    
+    !! 1. Define flag ldq_cdrag_from_gcm. This flag determines if the cdrag should be taken from the GCM or be calculated. 
+    !!    The default value is true if the q_cdrag variables was already initialized. This is the case when coupled to the LMDZ.
+
+    !Config Key   = CDRAG_FROM_GCM
+    !Config Desc  = Keep cdrag coefficient from gcm.
+    !Config If    = OK_SECHIBA
+    !Config Def   = y
+    !Config Help  = Set to .TRUE. if you want q_cdrag coming from GCM (if q_cdrag on initialization is non zero).
+    !Config         Keep cdrag coefficient from gcm for latent and sensible heat fluxes.
+    !Config Units = [FLAG]
+    IF ( ABS(MAXVAL(q_cdrag)) .LE. EPSILON(q_cdrag)) THEN
+       ldq_cdrag_from_gcm = .FALSE.
+    ELSE
+       ldq_cdrag_from_gcm = .TRUE.
+    ENDIF
+    CALL getin_p('CDRAG_from_GCM', ldq_cdrag_from_gcm)
+    IF (printlev>=2) WRITE(numout,*) "ldq_cdrag_from_gcm = ",ldq_cdrag_from_gcm
+
+    !! 2. Allocate module variables
+    ALLOCATE (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
+    
+    !! 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, pb, &
+     & evap_bare_lim, evapot, evapot_corr, snow, flood_frac, flood_res, frac_nobio, snow_nobio, totfrac_nobio, &
+     & swnet, swdown, coszang, ccanopy, humrel, veget, veget_max, lai, &
+     & laitop, laidow, VPD, &!!xchen
+     & qsintveg, qsintmax, assim_param, &
+     & vbeta , vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, gsmean, rveget, rstruct, cimean, gpp, co2_to_bm, &
+     & lalo, neighbours, resolution, ptnlev1, precip_rain, frac_age, tot_bare_soil, frac_snow_veg, frac_snow_nobio, &
+     & hist_id, hist2_id)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-) 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                         :: hist_id          !! _History_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                         :: hist2_id         !! _History_ file 2 identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index          !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in) :: indexlai  !! Indeces of the points on the 3D map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in) :: indexveg       !! Indeces of the points on the 3D map (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: u                !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: zlev             !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: 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)      :: 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 (kjpindex,nvm), INTENT (in)  :: lai              !! Leaf area index (m^2 m^{-2})
+!! liuly
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: laitop           !!xchen sunlit Leaf area index @tex ($m^2 m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: laidow           !!xchen shade Leaf area index @tex ($m^2 m^{-2}$) @endtex
+!! liuly above
+
+    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), INTENT (in)  :: co2_to_bm        !! virtual gpp ((gC m^{-2} s^{-1}), total area) 
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2), INTENT (in) :: assim_param !! min+max+opt temps, vcmax, vjmax
+                                                                           !! for photosynthesis (K ??)
+    REAL(r_std),DIMENSION (kjpindex,2),   INTENT (in)  :: lalo               !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,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 km of each grid-box in X and Y
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: ptnlev1            !! 1st level of soil temperature (Kelvin)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain        !! Rain precipitation expressed in mm/tstep
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT (in)  :: frac_age !! Age efficiency for isoprene emissions (from STOMATE)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil      !! Total evaporating bare soil fraction 
+    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)     :: 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 (out) :: rstruct          !! Structural resistance for the vegetation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: cimean           !! Mean leaf Ci (ppm)  
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out)  :: gpp              !! Assimilation ((gC m^{-2} s^{-1}), total area)  
+
+!! xchen add vpd for gpp simulation in Amazon
+    REAL(r_std), DIMENSION(kjpindex), INTENT (out)     :: VPD              !! Vapor Pressure Deficit (kPa)
+
+    !! 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  (-)
+
+    !! 0.4 Local variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: vbeta23            !! Beta for fraction of wetted foliage that will
+                                                                   !! transpire once intercepted water has evaporated (-)
+    REAL(r_std),DIMENSION (kjpindex)         :: raero              !! Aerodynamic resistance (s m^{-1})
+    INTEGER(i_std)                           :: ilai,jv     !!liulyc add define
+    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 
+
+
+!!@xchen use var_temp to add FAPAR, PAR_xc, LUE and PC in Wu's paper 
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp1
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp2                          
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp3                          
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp4                                                   
+    REAL(r_std),DIMENSION (kjpindex)         :: SVP
+    REAL(r_std), DIMENSION(kjpindex)         :: air_relhum         !! air relative humidity at 2m 
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_gsmean         !! mean stomatal conductan 
+!! liulyw above last 3 why?
+
+!_ ================================================================================================================================
+    
+    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
+
+    CALL diffuco_trans_co2 (kjpindex, swdown, pb, qsurf, qair, temp_air, temp_growth, rau, u, v, q_cdrag, humrel, &
+         assim_param, ccanopy, &
+         veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, &
+         rveget, rstruct, cimean, gsmean, gpp, &
+         co2_to_bm, vbeta23, hist_id, indexveg, indexlai, index, kjit, cim)
+
+!! liulyc
+!! 2018/11 replaced t2m and q2m by temp_air and qair; prognostic variables on first atmospheric model layer
+!!xchen add VPD                                                                 
+    VPD(:) = ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) ) &               
+    - ( qsurf(:) * pb(:) / (Tetens_1+qsurf(:)* Tetens_2) )                 
+    !!WRITE (numout,*) ' VPD before calculation: ', VPD(:)                        
+    ! VPD is needed in kPa                                                      
+    VPD(:) = VPD(:)/10.0                                                        
+    !!WRITE (numout,*) ' VPD after calculation: ', VPD(:)  
+    !!CALL qsatcalc (kjpindex, t2m, pb, qsatt)                                    
+    air_relhum(:) = &                                                           
+      ( qsurf(:) * pb(:) / (Tetens_1+qsurf(:)* Tetens_2) ) / &                  
+      ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) )                        
+    !!WRITE(numout, *) 'air_relhum=', air_relhum(:)                            
+    SVP(:) = 610.7*10**(7.5*(temp_air(:)-273.15)/(237.3+temp_air(:)-273.15))              
+    SVP(:) = SVP(:) * (1-air_relhum(:))                                         
+    !!WRITE(numout, *) 'SVP=',SVP(:)                         
+    DO jv = 1,nvm                                                               
+      var_gsmean(:,jv) = gsmean(:,jv)/VPD(:)                                    
+    ENDDO                                                                       
+!!xchen  
+
+    !
+    !biogenic emissions
+    !
+    IF ( ok_bvoc ) THEN
+       CALL chemistry_bvoc (kjpindex, swdown, coszang, temp_air, &
+            temp_sol, ptnlev1, precip_rain, humrel, veget_max, &
+            lai, frac_age, lalo, ccanopy, cim, wind, snow, &
+            veget, hist_id, hist2_id, kjit, index, &
+            indexlai, indexveg)
+    ENDIF
+    !
+    ! combination of coefficient : alpha and beta coefficient
+    ! beta coefficient for bare soil
+    !
+
+    CALL diffuco_bare (kjpindex, 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, lai, tot_bare_soil, vbeta1, vbeta2, vbeta3, vbeta4, vbeta, qsintmax)
+
+    CALL xios_orchidee_send_field("VPD",VPD) !! liulya
+    CALL xios_orchidee_send_field("SVP",SVP) !! liulya
+
+    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)
+
+!! liuly
+!!@xchen add FAPAR=(1-p1)-(1-p2)*exp(-0.5*lai/coszang); p1=0.05 and p2=0 for tower site Santarem km67
+    !!umol photons/m^2/s                                                        
+    var_temp1(:,:) = zero                                                       
+    var_temp2(:,:) = zero                                                       
+    var_temp3(:,:) = zero                                                       
+    var_temp4(:,:) = zero  
+
+    DO jv = 1,nvm                                                               
+       var_temp1(:,jv) = 1-0.05-exp(-0.5*lai(:,jv)/coszang(:))                       
+       var_temp2(:,jv) = swdown(:)*W_to_mol*RG_to_PAR
+       !!WHERE (var_temp2(:,jv) .GT. zero .AND. var_temp1(:,jv) .GT. zero)
+       var_temp3(:,jv) = var_temp2(:,jv)*var_temp1(:,jv) 
+       var_temp4(:,jv) = gpp(:,jv)                        
+       !!var_temp3(:,jv) = var_temp2(:,jv)*var_temp1(:,jv)
+       !!ENDWHERE                        
+    ENDDO    
+                                                                   
+    CALL xios_orchidee_send_field("FAPAR",var_temp1)                            
+    CALL xios_orchidee_send_field("PAR_xc",0.7*var_temp2)                           
+    CALL xios_orchidee_send_field("LUE",var_temp3)                              
+    CALL xios_orchidee_send_field("PC",var_temp4)
+    CALL xios_orchidee_send_field("Gc",var_gsmean)
+    CALL xios_orchidee_send_field("Gs",gsmean)       
+!! liulya above
+
+
+
+
+    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)
+       CALL histwrite_p(hist_id, 'cim', kjit, cim, kjpindex*nvm, indexveg)
+
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'raero', kjit, raero, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Wind', kjit, wind, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsatt', kjit, qsatt, kjpindex, index)
+       ENDIF
+    ELSE
+       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)
+    
+  END SUBROUTINE diffuco_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE		 			: diffuco_clear
+!!
+!>\BRIEF					Housekeeping module to deallocate the variables
+!! rstruct and raero
+!!
+!! DESCRIPTION				        : Housekeeping module to deallocate the variables
+!! rstruct and raero
+!!
+!! RECENT CHANGE(S)                             : None
+!!
+!! MAIN OUTPUT VARIABLE(S)	                : None
+!!
+!! REFERENCE(S)				        : None
+!!
+!! FLOWCHART                                    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_clear()
+
+    ! 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
+!_ ================================================================================================================================
+
+  !! 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
+       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))))
+
+          !! \latexonly 
+          !!     \input{diffucoaero13.tex}
+          !! \endlatexonly               
+          cd_tmp=cd_neut * (un - trois * cb * zri * zscf)
+       ENDIF
+       
+       !! If the Drag Coefficient becomes too small than the surface may uncouple from the atmosphere.
+       !! To prevent this, a minimum limit to the drag coefficient is defined as:
+       
+       !! \latexonly 
+       !!     \input{diffucoaero14.tex}
+       !! \endlatexonly
+       !!
+       q_cdrag(ji) = MAX(cd_tmp, 1.e-4/MAX(speed,min_wind))
+
+       ! In some situations it might be useful to give an upper limit on the cdrag as well. 
+       ! The line here should then be uncommented.
+      !q_cdrag(ji) = MIN(q_cdrag(ji), 0.5/MAX(speed,min_wind))
+
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' not ldqcdrag_from_gcm : diffuco_aero done '
+
+  END SUBROUTINE diffuco_aero
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_snow
+!!
+!>\BRIEF         This subroutine computes the beta coefficient for snow sublimation.
+!!
+!! DESCRIPTION   : This routine computes beta coefficient for snow sublimation, which
+!! integrates the snow on both vegetation and other surface types (e.g. ice, lakes,
+!! cities etc.) \n
+!!
+!! A critical depth of snow (snowcri) is defined to calculate the fraction of each grid-cell
+!! that is covered with snow (snow/snowcri) while the remaining part is snow-free.
+!! We also carry out a first calculation of sublimation (subtest) to lower down the beta
+!! coefficient if necessary (if subtest > snow). This is a predictor-corrector test. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta1 
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+SUBROUTINE diffuco_snow (kjpindex, qair, qsatt, rau, u, v,q_cdrag, &
+       & snow, frac_nobio, totfrac_nobio, snow_nobio, 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. min_sechiba ) 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) * frac_snow_nobio(ji, jv)
+
+           ! 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. min_sechiba ) 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. min_sechiba ) 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. min_sechiba ) 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)
+!! 
+!! 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 
+    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.4 Local variables
+    INTEGER(i_std)                                     :: ji
+
+!_ ================================================================================================================================
+
+  !! 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).
+!!
+!! 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 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):
+!!
+!!   2018/11 replaced t2m and q2m by temp_air and qair; prognostic variables on first atmospheric model layer
+!!
+!!   2006/06   N. de Noblet
+!!                - addition of q2m and t2m as input parameters for the 
+!!                calculation of Rveget
+!!                - introduction of vbeta23
+!!
+!! MAIN OUTPUT VARIABLE(S): beta coefficients, resistances, CO2 intercellular 
+!! concentration
+!!
+!! REFERENCE(S) :
+!! - Ball, J., T. Woodrow, and J. Berry (1987), A model predicting stomatal 
+!! conductance and its contribution to the control of photosynthesis under 
+!! different environmental conditions, Prog. Photosynthesis, 4, 221â 224.
+!! - Collatz, G., M. Ribas-Carbo, and J. Berry (1992), Coupled photosynthesis 
+!! stomatal conductance model for leaves of C4 plants, Aust. J. Plant Physiol.,
+!! 19, 519â538.
+!! - Farquhar, G., S. von Caemmener, and J. Berry (1980), A biochemical model of 
+!! photosynthesis CO2 fixation in leaves of C3 species, Planta, 149, 78â90.
+!! - Johnson, I. R., and J. Thornley (1984), A model of instantaneous and daily
+!! canopy photosynthesis, J Theor. Biol., 107, 531 545
+!! - McMurtrie, R.E., Rook, D.A. and Kelliher, F.M., 1990. Modelling the yield of Pinus radiata on a
+!! site limited by water and nitrogen. For. Ecol. Manage., 30: 381-413
+!! - Bounoua, L., Hall, F. G., Sellers, P. J., Kumar, A., Collatz, G. J., Tucker, C. J., and Imhoff, M. L. (2010), Quantifying the 
+!! negative feedback of vegetation to greenhouse warming: A modeling approach, Geophysical Research Letters, 37, Artn L23701, 
+!! Doi 10.1029/2010gl045338
+!! - Bounoua, L., Collatz, G. J., Sellers, P. J., Randall, D. A., Dazlich, D. A., Los, S. O., Berry, J. A., Fung, I., 
+!! Tucker, C. J., Field, C. B., and Jensen, T. G. (1999), Interactions between vegetation and climate: Radiative and physiological 
+!! effects of doubled atmospheric co2, Journal of Climate, 12, 309-324, Doi 10.1175/1520-0442(1999)012<0309:Ibvacr>2.0.Co;2
+!! - Sellers, P. J., Bounoua, L., Collatz, G. J., Randall, D. A., Dazlich, D. A., Los, S. O., Berry, J. A., Fung, I., 
+!! Tucker, C. J., Field, C. B., and Jensen, T. G. (1996), Comparison of radiative and physiological effects of doubled atmospheric
+!! co2 on climate, Science, 271, 1402-1406, DOI 10.1126/science.271.5254.1402
+!! - Lewis, J. D., Ward, J. K., and Tissue, D. T. (2010), Phosphorus supply drives nonlinear responses of cottonwood 
+!! (populus deltoides) to increases in co2 concentration from glacial to future concentrations, New Phytologist, 187, 438-448, 
+!! DOI 10.1111/j.1469-8137.2010.03307.x
+!! - Kattge, J., Knorr, W., Raddatz, T., and Wirth, C. (2009), Quantifying photosynthetic capacity and its relationship to leaf 
+!! nitrogen content for global-scale terrestrial biosphere models, Global Change Biology, 15, 976-991, 
+!! DOI 10.1111/j.1365-2486.2008.01744.x
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE diffuco_trans_co2 (kjpindex, swdown, pb, qsurf, qair, temp_air, temp_growth, rau, u, v, q_cdrag, humrel, &
+                                assim_param, Ca, &
+                                veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, &
+                                cimean, gsmean, gpp, &
+                                co2_to_bm, vbeta23, 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),DIMENSION (kjpindex), INTENT (in)            :: swdown           !! Downwelling short wave flux 
+                                                                                 !! @tex ($W m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qsurf            !! Near surface specific humidity 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair             !! Specific humidity at first atmospheric model layer
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air         !! Air temperature at first atmospheric model layer (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,npco2), INTENT (in)  :: assim_param      !! min+max+opt temps (K), vcmax, vjmax for 
+                                                                                 !! photosynthesis 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: Ca               !! CO2 concentration inside the canopy
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: humrel           !! Soil moisture stress (0-1,unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget            !! Coverage fraction of vegetation for each PFT 
+                                                                                 !! depending on LAI (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget_max        !! Maximum vegetation fraction of each PFT inside 
+                                                                                 !! the grid box (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: lai              !! Leaf area index @tex ($m^2 m^{-2}$) @endtex
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: qsintveg         !! Water on vegetation due to interception 
+                                                                                 !! @tex ($kg m^{-2}$) @endte
+    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 (kjpindex,nvm), INTENT (in)        :: co2_to_bm        !! virtual gpp ((gC m^{-2} s^{-1}), total area)
+    INTEGER(i_std),INTENT (in)                               :: hist_id          !! _History_ file identifier (-)    
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in) :: indexveg       !! Indeces of the points on the 3D map (-)   
+    INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in) :: indexlai  !! Indeces of the points on the 3D map
+INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces 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), INTENT (out)       :: cim              !! Intercellular CO2 over nlai 
+    !
+    !! 0.3 Modified variables
+    !
+ 
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: vcmax                               !! maximum rate of carboxylation 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex
+    INTEGER(i_std)                        :: ji, jv, jl, limit_photo             !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nlai+1) :: info_limitphoto
+    REAL(r_std), DIMENSION(kjpindex,nvm,nlai)  :: leaf_ci                        !! intercellular CO2 concentration (ppm)
+    REAL(r_std), DIMENSION(kjpindex)      :: leaf_ci_lowest                      !! intercellular CO2 concentration at the lowest 
+                                                                                 !! LAI level
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    INTEGER(i_std), DIMENSION(kjpindex)   :: ilai                                !! counter for loops on LAI levels (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: zqsvegrap                           !! relative water quantity in the water 
+                                                                                 !! interception reservoir (0-1,unitless) 
+    REAL(r_std)                           :: speed                               !! wind speed @tex ($m s^{-1}$) @endtex
+    ! Assimilation
+    LOGICAL, DIMENSION(kjpindex)          :: assimilate                          !! where assimilation is to be calculated 
+                                                                                 !! (unitless) 
+    LOGICAL, DIMENSION(kjpindex)          :: calculate                           !! where assimilation is to be calculated for 
+                                                                                 !! in the PFTs loop (unitless) 
+    INTEGER(i_std)                        :: nic,inic,icinic                     !! counter/indices (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex)   :: index_calc                          !! index (unitless)
+    INTEGER(i_std)                        :: nia,inia,nina,inina,iainia          !! counter/indices (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex)   :: index_assi,index_non_assi           !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex, nlai+1)      :: vc2                                 !! rate of carboxylation (at a specific LAI level) 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex, nlai+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, nlai+1)      :: 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,nlai+1)      :: gs                                  !! stomatal conductance to CO2 
+                                                                                 !! @tex ($\mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nlai)      :: 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)      :: assimtot                            !! total assimilation 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: Rdtot                               !! Total Day respiration (respiratory CO2 release other than by photorespiration) (mumol CO2 mâ2 sâ1) 
+    REAL(r_std), DIMENSION(kjpindex)      :: leaf_gs_top                         !! leaf stomatal conductance to H2O at topmost level 
+                                                                                 !! @tex ($\mol H2O m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nlai+1)        :: laitab                              !! tabulated LAI steps @tex ($m^2 m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: qsatt                               !! surface saturated humidity at 2m (??) 
+                                                                                 !! @tex ($g g^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nvm,nlai)      :: light                               !! fraction of light that gets through upper LAI    
+                                                                                 !! levels (0-1,unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Vcmax                             !! Temperature dependance of Vcmax (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: S_Vcmax_acclim_temp                 !! Entropy term for Vcmax 
+                                                                                 !! accounting for acclimation to temperature (J K-1 mol-1)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Jmax                              !! Temperature dependance of Jmax
+    REAL(r_std), DIMENSION(kjpindex)      :: S_Jmax_acclim_temp                  !! Entropy term for Jmax 
+                                                                                 !! accounting for acclimation toxs 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,nlai+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)                           :: 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, nlai+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, nlai+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), DIMENSION(kjpindex)      :: laisum                              !! when calculating cim over nlai
+
+! @defgroup Photosynthesis Photosynthesis
+! @{   
+    ! 1. Preliminary calculations\n
+!_ ================================================================================================================================
+
+    cim(:,:)=zero
+
+    !
+    ! 1.1 Calculate LAI steps\n
+    ! The integration at the canopy level is done over nlai fixed levels.
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.1.tex}
+    !! \endlatexonly
+! @}
+! @codeinc
+    DO jl = 1, nlai+1
+      laitab(jl) = laimax*(EXP(lai_level_depth*REAL(jl-1,r_std))-1.)/(EXP(lai_level_depth*REAL(nlai,r_std))-un)
+    ENDDO
+! @endcodeinc
+
+! @addtogroup Photosynthesis
+! @{   
+    !
+    ! 1.2 Calculate light fraction for each LAI step\n
+    ! The available light follows a simple Beer extinction law. 
+    ! The extinction coefficients (ext_coef) are PFT-dependant constants and are defined in constant_co2.f90.
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.2.tex}
+    !! \endlatexonly
+! @}
+! @codeinc
+    DO jl = 1, nlai
+      DO jv = 1, nvm
+        light(jv,jl) = exp( -ext_coeff(jv)*laitab(jl) )
+      ENDDO
+    ENDDO 
+! @endcodeinc
+    !
+    ! Photosynthesis parameters
+    !
+
+    IF (downregulation_co2) THEN
+       DO jv= 1, nvm
+          vcmax(:,jv) = assim_param(:,jv,ivcmax)*(un-downregulation_co2_coeff(jv)*log(Ca(:)/downregulation_co2_baselevel))
+       ENDDO
+    ELSE
+       vcmax(:,:) = assim_param(:,:,ivcmax)
+    ENDIF
+
+!    DO jv = 1, nvm
+!       vcmax(:,:) = Vcmax25(jv)
+!    ENDDO
+
+! @addtogroup Photosynthesis
+! @{   
+    !
+    ! 1.3 Estimate relative humidity of air (for calculation of the stomatal conductance).\n
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.3.tex}
+    !! \endlatexonly
+! @}
+    !
+
+    CALL qsatcalc (kjpindex, temp_air, pb, qsatt)
+    air_relhum(:) = &
+      ( qair(:) * pb(:) / (Tetens_1+qair(:)* Tetens_2) ) / &
+      ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) )
+
+
+    VPD(:) = ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) ) &
+         - ( qair(:) * pb(:) / (Tetens_1+qair(:)* Tetens_2) )
+    ! VPD is needed in kPa
+    VPD(:) = VPD(:)/10.
+
+    ! liulyt 20220223
+    ! Check whether qsatt has update is needed before VPD calculation 
+    CALL xios_orchidee_send_field("VPD_lly",VPD) !! liulya
+
+    !
+    ! 2. beta coefficient for vegetation transpiration
+    !
+    rstruct(:,1) = rstruct_const(1)
+    rveget(:,:) = undef_sechiba
+    !
+    vbeta3(:,:) = zero
+    vbeta3pot(:,:) = zero
+    gsmean(:,:) = zero
+    gpp(:,:) = zero
+    !
+    cimean(:,1) = Ca(:)
+    !
+    ! @addtogroup Photosynthesis
+    ! @{   
+    ! 2. Loop over vegetation types\n
+    ! @} 
+    !
+    DO jv = 2,nvm
+       gamma_star(:)=zero
+       Kmo(:)=zero
+       Kmc(:)=zero
+       gm(:)=zero
+       g0var(:) =zero
+
+       Cc(:,:)=zero
+       Vc2(:,:)=zero
+       JJ(:,:)=zero
+       info_limitphoto(:,:)=zero
+       gs(:,:)=zero
+       templeafci(:,:)=zero
+       assimi(:,:)=zero
+       Rd(:,:)=zero
+
+      !
+      ! @addtogroup Photosynthesis
+      ! @{   
+      !
+      ! 2.1 Initializations\n
+      !! \latexonly
+      !! \input{diffuco_trans_co2_2.1.tex}
+      !! \endlatexonly
+      ! @}      
+      !
+      ! beta coefficient for vegetation transpiration
+      !
+      rstruct(:,jv) = rstruct_const(jv)
+      cimean(:,jv) = Ca(:)
+      !
+      !! mask that contains points where there is photosynthesis
+      !! For the sake of vectorisation [DISPENSABLE], computations are done only for convenient points.
+      !! nia is the number of points where the assimilation is calculated and nina the number of points where photosynthesis is not
+      !! calculated (based on criteria on minimum or maximum values on LAI, vegetation fraction, shortwave incoming radiation, 
+      !! temperature and relative humidity).
+      !! For the points where assimilation is not calculated, variables are initialized to specific values. 
+      !! The assimilate(kjpindex) array contains the logical value (TRUE/FALSE) relative to this photosynthesis calculation.
+      !! The index_assi(kjpindex) array indexes the nia points with assimilation, whereas the index_no_assi(kjpindex) array indexes
+      !! the nina points with no assimilation.
+      nia=0
+      nina=0
+      !
+      DO ji=1,kjpindex
+         !
+         IF ( ( lai(ji,jv) .GT. 0.01 ) .AND. &
+              ( veget_max(ji,jv) .GT. min_sechiba ) ) THEN
+            
+            IF ( ( veget(ji,jv) .GT. min_sechiba ) .AND. &
+                 ( swdown(ji) .GT. min_sechiba )   .AND. &
+                 ( humrel(ji,jv) .GT. min_sechiba) .AND. &
+                 ( temp_growth(ji) .GT. tphoto_min(jv) ) .AND. &
+                 ( temp_growth(ji) .LT. tphoto_max(jv) ) ) THEN
+               !
+               assimilate(ji) = .TRUE.
+               nia=nia+1
+               index_assi(nia)=ji
+               !
+            ELSE
+               !
+               assimilate(ji) = .FALSE.
+               nina=nina+1
+               index_non_assi(nina)=ji
+               !
+            ENDIF
+         ELSE
+            !
+            assimilate(ji) = .FALSE.
+            nina=nina+1
+            index_non_assi(nina)=ji
+            !
+         ENDIF
+         !
+
+      ENDDO
+      !
+
+      gstot(:) = zero
+      gstop(:) = zero
+      assimtot(:) = zero
+      Rdtot(:)=zero
+      leaf_gs_top(:) = zero
+      !
+      zqsvegrap(:) = zero
+      WHERE (qsintmax(:,jv) .GT. min_sechiba)
+      !! relative water quantity in the water interception reservoir
+          zqsvegrap(:) = MAX(zero, qsintveg(:,jv) / qsintmax(:,jv))
+      ENDWHERE
+      !
+      !! Calculates the water limitation factor.
+      water_lim(:) = humrel(:,jv)
+
+      ! give a default value of ci for all pixel that do not assimilate
+      DO jl=1,nlai
+         DO inina=1,nina
+            leaf_ci(index_non_assi(inina),jv,jl) = Ca(index_non_assi(inina)) 
+         ENDDO
+      ENDDO
+      !
+      ilai(:) = 1
+      !
+      ! Here is the calculation of assimilation and stomatal conductance
+      ! based on the work of Farquahr, von Caemmerer and Berry (FvCB model) 
+      ! as described in Yin et al. 2009
+      ! Yin et al. developed a extended version of the FvCB model for C4 plants
+      ! and proposed an analytical solution for both photosynthesis pathways (C3 and C4)
+      ! Photosynthetic parameters used are those reported in Yin et al. 
+      ! Except For Vcmax25, relationships between Vcmax25 and Jmax25 for which we use 
+      ! Medlyn et al. (2002) and Kattge & Knorr (2007)
+      ! Because these 2 references do not consider mesophyll conductance, we neglect this term
+      ! in the formulations developed by Yin et al. 
+      ! Consequently, gm (the mesophyll conductance) tends to the infinite
+      ! This is of importance because as stated by Kattge & Knorr and Medlyn et al.,
+      ! values of Vcmax and Jmax derived with different model parametrizations are not 
+      ! directly comparable and the published values of Vcmax and Jmax had to be standardized
+      ! to one consistent formulation and parametrization
+
+      ! See eq. 6 of Yin et al. (2009)
+      ! Parametrization of Medlyn et al. (2002) - from Bernacchi et al. (2001)
+      T_KmC(:)        = Arrhenius(kjpindex,temp_air,298.,E_KmC(jv))
+      T_KmO(:)        = Arrhenius(kjpindex,temp_air,298.,E_KmO(jv))
+      T_Sco(:)        = Arrhenius(kjpindex,temp_air,298.,E_Sco(jv))
+      T_gamma_star(:) = Arrhenius(kjpindex,temp_air,298.,E_gamma_star(jv))
+
+
+      ! Parametrization of Yin et al. (2009) - from Bernacchi et al. (2001)
+      T_Rd(:)         = Arrhenius(kjpindex,temp_air,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_air,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_air,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,temp_air,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
+      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(:))
+
+!!xchen
+      CALL xios_orchidee_send_field("fVPD",fvpd)   
+
+      ! 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/temp_air(:)) * (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
+
+      !
+      ! @addtogroup Photosynthesis
+      ! @{   
+      !
+      ! 2.4 Loop over LAI discretized levels to estimate assimilation and conductance\n
+      ! @}           
+      !
+      !! The calculate(kjpindex) array is of type logical to indicate wether we have to sum over this LAI fixed level (the LAI of
+      !! the point for the PFT is lower or equal to the LAI level value). The number of such points is incremented in nic and the 
+      !! corresponding point is indexed in the index_calc array.
+      JJ(:,:)=zero
+      vc2(:,:)=zero
+      vj2(:,:)=zero
+      Cc(:,:)=zero
+      gs(:,:)=zero
+      assimi(:,:)=zero
+      Rd(:,:)=zero
+
+      DO jl = 1, nlai
+         !
+         nic=0
+         calculate(:) = .FALSE.
+         !
+         IF (nia .GT. 0) then
+            DO inia=1,nia
+               calculate(index_assi(inia)) = (laitab(jl) .LE. lai(index_assi(inia),jv) )
+               IF ( calculate(index_assi(inia)) ) THEN
+                  nic=nic+1
+                  index_calc(nic)=index_assi(inia)
+               ENDIF
+            ENDDO
+         ENDIF
+         !
+         ! @addtogroup Photosynthesis
+         ! @{   
+         !
+         ! 2.4.1 Vmax is scaled into the canopy due to reduction of nitrogen 
+         !! (Johnson and Thornley,1984).\n
+         !! \latexonly
+         !! \input{diffuco_trans_co2_2.4.1.tex}
+         !! \endlatexonly
+         ! @}           
+         !
+         N_Vcmax = ( un - .7_r_std * ( un - light(jv,jl) ) )
+         !
+
+         vc2(:,jl) = vc(:) * N_Vcmax * MAX(1-stress_vcmax(jv), water_lim(:))
+         vj2(:,jl) = vj(:) * N_Vcmax * MAX(1-stress_vcmax(jv), water_lim(:))
+
+         ! see Comment in legend of Fig. 6 of Yin et al. (2009)
+         ! Rd25 is assumed to equal 0.01 Vcmax25 
+         Rd(:,jl) = vcmax(:,jv) * N_Vcmax * 0.01 * T_Rd(:)  * MAX(1-stress_vcmax(jv), water_lim(:))
+
+         Iabs(:)=swdown(:)*W_to_mol*RG_to_PAR*ext_coeff(jv)*light(jv,jl)
+         
+         ! eq. 4 of Yin et al (2009)
+         Jmax(:)=vj2(:,jl)
+         JJ(:,jl) = ( alpha_LL(jv) * Iabs(:) + Jmax(:) - sqrt((alpha_LL(jv) * Iabs(:) + Jmax(:) )**2. &
+              - 4 * theta(jv) * Jmax(:) * alpha_LL(jv) * Iabs(:)) ) &
+              / ( 2 * theta(jv))
+
+         !
+         IF ( is_c4(jv) )  THEN
+            !
+            ! @addtogroup Photosynthesis
+            ! @{   
+            !
+            ! 2.4.2 Assimilation for C4 plants (Collatz et al., 1992)\n
+            !! \latexonly
+            !! \input{diffuco_trans_co2_2.4.2.tex}
+            !! \endlatexonly
+            ! @}           
+            !
+            !
+            !
+            IF (nic .GT. 0) THEN
+               DO inic=1,nic
+
+                  ! Analytical resolution of the Assimilation based Yin et al. (2009)
+                  icinic=index_calc(inic)
+
+                  ! Eq. 28 of Yin et al. (2009)
+                  fcyc= 1. - ( 4.*(1.-fpsir(jv))*(1.+fQ(jv)) + 3.*h_protons(jv)*fpseudo(jv) ) / &
+                       ( 3.*h_protons(jv) - 4.*(1.-fpsir(jv)))
+                                    
+                  ! See paragraph after eq. (20b) of Yin et al.
+                  Rm=Rd(icinic,jl)/2.
+                                
+                  ! We assume that cs_star equals ci_star (see Comment in legend of Fig. 6 of Yin et al. (2009)
+                  ! Equation 26 of Yin et al. (2009)
+                  Cs_star = (gbs(jv) * low_gamma_star(icinic) * Oi - &
+                       ( 1. + low_gamma_star(icinic) * alpha(jv) / 0.047) * Rd(icinic,jl) + Rm ) &
+                       / ( gbs(jv) + kp(jv) ) 
+
+                  ! eq. 11 of Yin et al (2009)
+                  J2 = JJ(icinic,jl) / ( 1. - fpseudo(jv) / ( 1. - fcyc ) )
+
+                  ! Equation right after eq. (20d) of Yin et al. (2009)
+                  z = ( 2. + fQ(jv) - fcyc ) / ( h_protons(jv) * (1. - fcyc ))
+
+                  VpJ2 = fpsir(jv) * J2 * z / 2.
+
+                  A_3=9999.
+
+                  ! See eq. right after eq. 18 of Yin et al. (2009)
+                  DO limit_photo=1,2
+                     ! Is Vc limiting the Assimilation
+                     IF ( limit_photo .EQ. 1 ) THEN
+                        a = 1. + kp(jv) / gbs(jv)
+                        b = 0.
+                        x1 = Vc2(icinic,jl)
+                        x2 = KmC(icinic)/KmO(icinic)
+                        x3 = KmC(icinic)
+                        ! Is J limiting the Assimilation
+                     ELSE
+                        a = 1.
+                        b = VpJ2
+                        x1 = (1.- fpsir(jv)) * J2 * z / 3.
+                        x2 = 7. * low_gamma_star(icinic) / 3.
+                        x3 = 0.
+                     ENDIF
+
+                     m=fvpd(icinic)-g0var(icinic)/gb_co2(icinic)
+                     d=g0var(icinic)*(Ca(icinic)-Cs_star) + fvpd(icinic)*Rd(icinic,jl)
+                     f=(b-Rm-low_gamma_star(icinic)*Oi*gbs(jv))*x1*d + a*gbs(jv)*x1*Ca(icinic)*d
+                     j=(b-Rm+gbs(jv)*x3 + x2*gbs(jv)*Oi)*m + (alpha(jv)*x2/0.047-1.)*d &
+                          + a*gbs(jv)*(Ca(icinic)*m - d/gb_co2(icinic) - (Ca(icinic) - Cs_star ))
+ 
+                     g=(b-Rm-low_gamma_star(icinic)*Oi*gbs(jv))*x1*m - (alpha(jv)*low_gamma_star(icinic)/0.047+1.)*x1*d &
+                          + a*gbs(jv)*x1*(Ca(icinic)*m - d/gb_co2(icinic) - (Ca(icinic)-Cs_star ))
+ 
+                     h=-((alpha(jv)*low_gamma_star(icinic)/0.047+1.)*x1*m + (a*gbs(jv)*x1*(m-1.))/gb_co2(icinic) )
+                     i= ( b-Rm + gbs(jv)*x3 + x2*gbs(jv)*Oi )*d + a*gbs(jv)*Ca(icinic)*d
+                     l= ( alpha(jv)*x2/0.047 - 1.)*m - (a*gbs(jv)*(m-1.))/gb_co2(icinic)
+ 
+                     p = (j-(h-l*Rd(icinic,jl))) / l
+                     q = (i+j*Rd(icinic,jl)-g) / l
+                     r = -(f-i*Rd(icinic,jl)) / l 
+ 
+                     ! See Yin et al. (2009) and  Baldocchi (1994)
+                     QQ = ( (p**2._r_std) - 3._r_std * q) / 9._r_std
+                     UU = ( 2._r_std* (p**3._r_std) - 9._r_std *p*q + 27._r_std *r) /54._r_std
+
+                     IF ( (QQ .GE. 0._r_std) .AND. (ABS(UU/(QQ**1.5_r_std) ) .LE. 1._r_std) ) THEN
+                        PSI = ACOS(UU/(QQ**1.5_r_std))
+                        A_3_tmp = -2._r_std * SQRT(QQ) * COS(( PSI + 4._r_std * PI)/3._r_std ) - p / 3._r_std
+                        IF (( A_3_tmp .LT. A_3 )) THEN
+                           A_3 = A_3_tmp
+                           info_limitphoto(icinic,jl)=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(icinic,jl)
+                           x2 = KmC(icinic)/KmO(icinic)
+                           x3 = KmC(icinic)
+                           info_limitphoto(icinic,jl)=1.
+                        ENDIF
+                     ENDIF
+
+                     IF ( ( A_3 .EQ. 9999. ) .OR. ( A_3 .LT. (-Rd(icinic,jl)) ) ) THEN
+                        IF ( printlev>=4 ) THEN
+                           WRITE(numout,*) 'We have a problem in diffuco_trans_co2 for A_3'
+                           WRITE(numout,*) 'no real positive solution found for pft:',jv
+                           WRITE(numout,*) 'temp_air:',temp_air(icinic)
+                           WRITE(numout,*) 'vpd:',vpd(icinic)
+                        END IF
+                        A_3 = -Rd(icinic,jl)
+                     ENDIF
+                     assimi(icinic,jl) = A_3
+
+                     IF ( ABS( assimi(icinic,jl) + Rd(icinic,jl) ) .LT. min_sechiba ) THEN
+                        gs(icinic,jl) = g0var(icinic)
+                        !leaf_ci keeps its initial value (Ca).
+                     ELSE
+                        ! Eq. 24 of Yin et al. (2009) 
+                        Obs = ( alpha(jv) * assimi(icinic,jl) ) / ( 0.047 * gbs(jv) ) + Oi
+                        ! Eq. 23 of Yin et al. (2009)
+                        Cc(icinic,jl) = ( ( assimi(icinic,jl) + Rd(icinic,jl) ) * ( x2 * Obs + x3 ) + low_gamma_star(icinic) &
+                             * Obs * x1 ) &
+                             / MAX(min_sechiba, x1 - ( assimi(icinic,jl) + Rd(icinic,jl) ))
+                        ! Eq. 22 of Yin et al. (2009)
+                        leaf_ci(icinic,jv,jl) = ( Cc(icinic,jl) - ( b - assimi(icinic,jl) - 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
+                        gs(icinic,jl) = g0var(icinic) + ( assimi(icinic,jl) + Rd(icinic,jl) ) / &
+                             ( Ca(icinic) - Cs_star ) * fvpd(icinic)             
+                     ENDIF
+                  ENDDO                  
+               ENDDO
+            ENDIF
+         ELSE
+            !
+            ! @addtogroup Photosynthesis
+            ! @{   
+            !
+            ! 2.4.3 Assimilation for C3 plants (Farqhuar et al., 1980)\n
+            !! \latexonly
+            !! \input{diffuco_trans_co2_2.4.3.tex}
+            !! \endlatexonly
+            ! @}           
+            !
+            !
+            IF (nic .GT. 0) THEN
+               DO inic=1,nic
+                  icinic=index_calc(inic)
+			
+                  A_1=9999.
+
+                  ! See eq. right after eq. 18 of Yin et al. (2009)
+                  DO limit_photo=1,2
+                     ! Is Vc limiting the Assimilation
+                     IF ( limit_photo .EQ. 1 ) THEN
+                        x1 = vc2(icinic,jl)
+                        ! It should be O not Oi (comment from Vuichard)
+                        x2 = KmC(icinic) * ( 1. + 2*gamma_star(icinic)*Sco(icinic) / KmO(icinic) )
+                        ! Is J limiting the Assimilation
+                     ELSE
+                        x1 = JJ(icinic,jl)/4.
+                        x2 = 2. * gamma_star(icinic)
+                     ENDIF
+
+
+                     ! See Appendix B of Yin et al. (2009)
+                     a = g0var(icinic) * ( x2 + gamma_star(icinic) ) + &
+                          ( g0var(icinic) / gm(icinic) + fvpd(icinic) ) * ( x1 - Rd(icinic,jl) )
+                     b = Ca(icinic) * ( x1 - Rd(icinic,jl) ) - gamma_star(icinic) * x1 - Rd(icinic,jl) * x2
+                     c = Ca(icinic) + x2 + ( 1./gm(icinic) + 1./gb_co2(icinic) ) * ( x1 - Rd(icinic,jl) ) 
+                     d = x2 + gamma_star(icinic) + ( x1 - Rd(icinic,jl) ) / gm(icinic)
+                     m = 1./gm(icinic) + ( g0var(icinic)/gm(icinic) + fvpd(icinic) ) * ( 1./gm(icinic) + 1./gb_co2(icinic) )  
+   
+                     p = - ( d + (x1 - Rd(icinic,jl) ) / gm(icinic) + a * ( 1./gm(icinic) + 1./gb_co2(icinic) ) + &
+                          ( g0var(icinic)/gm(icinic) + fvpd(icinic) ) * c ) / m
+   
+                     q = ( d * ( x1 - Rd(icinic,jl) ) + a*c + ( g0var(icinic)/gm(icinic) + fvpd(icinic) ) * b ) / m
+                     r = - a * b / m
+   
+                     ! See Yin et al. (2009) 
+                     QQ = ( (p**2._r_std) - 3._r_std * q) / 9._r_std
+                     UU = ( 2._r_std* (p**3._r_std) - 9._r_std *p*q + 27._r_std *r) /54._r_std
+               
+                     IF ( (QQ .GE. 0._r_std) .AND. (ABS(UU/(QQ**1.5_r_std) ) .LE. 1._r_std) ) THEN
+                        PSI = ACOS(UU/(QQ**1.5_r_std))
+                        A_1_tmp = -2._r_std * SQRT(QQ) * COS( PSI / 3._r_std ) - p / 3._r_std
+                        IF (( A_1_tmp .LT. A_1 )) THEN
+                           A_1 = A_1_tmp
+                           info_limitphoto(icinic,jl)=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(icinic,jl)
+                           ! It should be O not Oi (comment from Vuichard)
+                           x2 = KmC(icinic) * ( 1. + 2*gamma_star(icinic)*Sco(icinic) / KmO(icinic) )                           
+                           info_limitphoto(icinic,jl)=1.
+                        ENDIF
+                     ENDIF
+                  ENDDO
+                  IF ( (A_1 .EQ. 9999.) .OR. ( A_1 .LT. (-Rd(icinic,jl)) ) ) THEN
+                     IF ( printlev>=4 ) THEN
+                        WRITE(numout,*) 'We have a problem in diffuco_trans_co2 for A_1'
+                        WRITE(numout,*) 'no real positive solution found for pft:',jv
+                        WRITE(numout,*) 'temp_air:',temp_air(icinic)
+                        WRITE(numout,*) 'vpd:',vpd(icinic)
+                     END IF
+                     A_1 = -Rd(icinic,jl)
+                  ENDIF
+                  assimi(icinic,jl) = A_1
+
+                  IF ( ABS( assimi(icinic,jl) + Rd(icinic,jl) ) .LT. min_sechiba ) THEN
+                     gs(icinic,jl) = g0var(icinic)
+                  ELSE
+                     ! Eq. 18 of Yin et al. (2009)
+                     Cc(icinic,jl) = ( gamma_star(icinic) * x1 + ( assimi(icinic,jl) + Rd(icinic,jl) ) * x2 )  &
+                          / MAX( min_sechiba, x1 - ( assimi(icinic,jl) + Rd(icinic,jl) ) )
+                     ! Eq. 17 of Yin et al. (2009)
+                     leaf_ci(icinic,jv,jl) = Cc(icinic,jl) + assimi(icinic,jl) / gm(icinic) 
+                     ! See eq. right after eq. 15 of Yin et al. (2009)
+                     ci_star = gamma_star(icinic) - Rd(icinic,jl) / gm(icinic)
+                     ! 
+                     ! Eq. 15 of Yin et al. (2009)
+                     gs(icinic,jl) = g0var(icinic) + ( assimi(icinic,jl) + Rd(icinic,jl) ) / ( leaf_ci(icinic,jv,jl) &
+                          - ci_star ) * fvpd(icinic)
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDIF
+         !
+         IF (nic .GT. 0) THEN
+            !
+            DO inic=1,nic
+               !
+               ! @addtogroup Photosynthesis
+               ! @{   
+               !
+               !! 2.4.4 Estimatation of the stomatal conductance (Ball et al., 1987).\n
+               !! \latexonly
+               !! \input{diffuco_trans_co2_2.4.4.tex}
+               !! \endlatexonly
+               ! @}           
+               !
+               icinic=index_calc(inic)
+               !
+               ! keep stomatal conductance of topmost level
+               !
+               IF ( jl .EQ. 1 ) THEN
+                  leaf_gs_top(icinic) = gs(icinic,jl)
+                  !
+               ENDIF
+               !
+               ! @addtogroup Photosynthesis
+               ! @{   
+               !
+               !! 2.4.5 Integration at the canopy level\n
+               !! \latexonly
+               !! \input{diffuco_trans_co2_2.4.5.tex}
+               !! \endlatexonly
+               ! @}           
+               ! total assimilation and conductance
+               assimtot(icinic) = assimtot(icinic) + &
+                    assimi(icinic,jl) * (laitab(jl+1)-laitab(jl))
+               Rdtot(icinic) = Rdtot(icinic) + &
+                    Rd(icinic,jl) * (laitab(jl+1)-laitab(jl))
+               gstot(icinic) = gstot(icinic) + &
+                    gs(icinic,jl) * (laitab(jl+1)-laitab(jl))
+               !
+               ilai(icinic) = jl
+               !
+            ENDDO
+            !
+         ENDIF
+      ENDDO  ! loop over LAI steps
+      
+ 
+      IF(jv==testpft) THEN
+         templeafci(:,:)=leaf_ci(:,testpft,:)
+         CALL histwrite_p(hist_id, 'Cc', kjit, Cc, kjpindex*(nlai+1), indexlai)
+         CALL histwrite_p(hist_id, 'Vc', kjit, Vc2, kjpindex*(nlai+1), indexlai)
+         CALL histwrite_p(hist_id, 'Vj', kjit, JJ, kjpindex*(nlai+1), indexlai)
+         CALL histwrite_p(hist_id, 'limitphoto', kjit, info_limitphoto, kjpindex*(nlai+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*(nlai+1), indexlai)
+         CALL histwrite_p(hist_id, 'leafci', kjit, templeafci, kjpindex*(nlai), indexlai)
+         CALL histwrite_p(hist_id, 'assimi', kjit, assimi, kjpindex*(nlai+1), indexlai)
+         CALL histwrite_p(hist_id, 'Rd', kjit, Rd, kjpindex*(nlai+1), indexlai)
+      ENDIF
+      !! Calculated intercellular CO2 over nlai needed for the chemistry module
+      cim(:,jv)=0.
+      laisum(:)=0
+      DO jl=1,nlai
+         WHERE (laitab(jl) .LE. lai(:,jv) )
+            cim(:,jv)= cim(:,jv)+leaf_ci(:,jv,jl)*(laitab(jl+1)-laitab(jl))
+            laisum(:)=laisum(:)+ (laitab(jl+1)-laitab(jl))
+         ENDWHERE
+      ENDDO
+      WHERE (laisum(:)>0)
+         cim(:,jv)= cim(:,jv)/laisum(:)
+      ENDWHERE
+
+
+      !
+      !! 2.5 Calculate resistances
+      !
+      IF (nia .GT. 0) THEN
+         !
+         DO inia=1,nia
+            !
+            iainia=index_assi(inia)
+
+            !! Mean stomatal conductance for CO2 (mol m-2 s-1)
+            gsmean(iainia,jv) = gstot(iainia)
+            !
+            ! cimean is the "mean ci" calculated in such a way that assimilation 
+            ! calculated in enerbil is equivalent to assimtot
+            !
+            IF ( ABS(gsmean(iainia,jv)-g0var(iainia)*laisum(iainia)) .GT. min_sechiba) THEN
+               cimean(iainia,jv) = (fvpd(iainia)*(assimtot(iainia)+Rdtot(iainia))) /&
+                 (gsmean(iainia,jv)-g0var(iainia)*laisum(iainia)) + gamma_star(iainia) 
+            ELSE
+               cimean(iainia,jv) = gamma_star(iainia) 
+            ENDIF
+                 
+            ! conversion from umol m-2 (PFT) s-1 to gC m-2 (mesh area) tstep-1
+            gpp(iainia,jv) = assimtot(iainia)*12e-6*veget_max(iainia,jv)*dt_sechiba
+            
+            !
+            ! conversion from mol/m^2/s to m/s
+            !
+            ! As in Pearcy, Schulze and Zimmermann
+            ! Measurement of transpiration and leaf conductance
+            ! Chapter 8 of Plant Physiological Ecology
+            ! Field methods and instrumentation, 1991
+            ! Editors:
+            !
+            !    Robert W. Pearcy,
+            !    James R. Ehleringer,
+            !    Harold A. Mooney,
+            !    Philip W. Rundel
+            !
+            ! ISBN: 978-0-412-40730-7 (Print) 978-94-010-9013-1 (Online)
+
+            gstot(iainia) =  mol_to_m_1 *(temp_air(iainia)/tp_00)*&
+                 (pb_std/pb(iainia))*gstot(iainia)*ratio_H2O_to_CO2
+            gstop(iainia) =  mol_to_m_1 * (temp_air(iainia)/tp_00)*&
+                 (pb_std/pb(iainia))*leaf_gs_top(iainia)*ratio_H2O_to_CO2*&
+                 laitab(ilai(iainia)+1)
+            !
+            rveget(iainia,jv) = un/gstop(iainia)
+
+            !
+            !
+            ! rstruct is the difference between rtot (=1./gstot) and rveget
+            !
+            ! Correction Nathalie - le 27 Mars 2006 - Interdire a rstruct d'etre negatif
+            !rstruct(iainia,jv) = un/gstot(iainia) - &
+            !     rveget(iainia,jv)
+            rstruct(iainia,jv) = MAX( un/gstot(iainia) - &
+                 rveget(iainia,jv), min_sechiba)
+            !
+            !
+            !! wind is a global variable of the diffuco module.
+            speed = MAX(min_wind, wind(iainia))
+            !
+            ! beta for transpiration
+            !
+            ! Corrections Nathalie - 28 March 2006 - on advices of Fred Hourdin
+            !! Introduction of a potentiometer rveg_pft to settle the rveg+rstruct sum problem in the coupled mode.
+            !! rveg_pft=1 in the offline mode. rveg_pft is a global variable declared in the diffuco module.
+            !vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+            !  (un - zqsvegrap(iainia)) * &
+            !  (un / (un + speed * q_cdrag(iainia) * (rveget(iainia,jv) + &
+            !   rstruct(iainia,jv))))
+            !! Global resistance of the canopy to evaporation
+            cresist=(un / (un + speed * q_cdrag(iainia) * &
+                 veget(iainia,jv)/veget_max(iainia,jv) * &
+                 (rveg_pft(jv)*(rveget(iainia,jv) + rstruct(iainia,jv)))))
+
+            IF ( humrel(iainia,jv) >= min_sechiba ) THEN
+               vbeta3(iainia,jv) = veget(iainia,jv) * &
+                    (un - zqsvegrap(iainia)) * cresist + &
+                    MIN( vbeta23(iainia,jv), veget(iainia,jv) * &
+                    zqsvegrap(iainia) * cresist )
+            ELSE
+               ! Because of a minimum conductance g0, vbeta3 cannot be zero even if humrel=0
+               ! in the above equation.
+               ! Here, we force transpiration to be zero when the soil cannot deliver it
+               vbeta3(iainia,jv) = zero
+            END IF
+
+            ! vbeta3pot for computation of potential transpiration (needed for irrigation)
+            vbeta3pot(iainia,jv) = MAX(zero, veget(iainia,jv) * cresist)
+            !
+            !
+         ENDDO
+         !
+      ENDIF
+      !
+   END DO         ! loop over vegetation types
+   !
+   CALL xios_orchidee_send_field("gstot_lly",gstot)
+   ! Add virtual gpp (co2_to_bm) to the gpp.
+   ! Virtual gpp can be created when introducing new pft or for correction of carbon fluxes 
+   ! for instance for adjustment of Ra at end of the day.
+   gpp(:,:) = gpp(:,:) + co2_to_bm(:,:)
+      
+   IF (printlev>=3) WRITE (numout,*) ' diffuco_trans_co2 done '
+
+
+END SUBROUTINE diffuco_trans_co2
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	   : diffuco_comb
+!!
+!>\BRIEF           This routine combines the previous partial beta 
+!! coefficients and calculates the total alpha and complete beta coefficients.
+!!
+!! DESCRIPTION	   : Those integrated coefficients are used to calculate (in enerbil.f90) the total evapotranspiration 
+!! from the grid-cell. \n
+!!
+!! In the case that air is more humid than surface, dew deposition can occur (negative latent heat flux). 
+!! In this instance, for temperature above zero, all of the beta coefficients are set to 0, except for 
+!! interception (vbeta2) and bare soil (vbeta4 with zero soil resistance). The amount of water that is 
+!! intercepted by leaves is calculated based on the value of LAI of the surface. In the case of freezing 
+!! temperatures, water is added to the snow reservoir, and so vbeta4 and vbeta2 are set to 0, and the 
+!! total vbeta 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, lai, tot_bare_soil, vbeta1, vbeta2, vbeta3 , vbeta4, vbeta, qsintmax)    
+    
+    ! Ajout qsintmax dans les arguments de la routine Nathalie / le 13-03-2006
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                           :: kjpindex   !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u          !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v          !! Nortward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag    !! 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)    :: lai        !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)        :: tot_bare_soil!! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vbeta      !! Total beta coefficient (-)
+
+    !! 0.3 Modified variables 
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: vbeta1     !! Beta for sublimation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: vbeta4     !! Beta for Bare soil evaporation (-) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: humrel     !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: vbeta2     !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: vbeta3     !! Beta for Transpiration (-)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                       :: ji, jv
+    REAL(r_std)                                          :: zevtest, zsoil_moist, zrapp
+    REAL(r_std), DIMENSION(kjpindex)                     :: qsatt
+    LOGICAL, DIMENSION(kjpindex)                         :: toveg, tosnow
+    REAL(r_std)                                          :: coeff_dew_veg
+!_ ================================================================================================================================
+    
+    !! 1 If we are in presence of dew
+     
+    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)
+      ENDIF
+      IF ( tosnow(ji) ) THEN
+        vbeta1(ji) = un
+        vbeta4(ji) = zero
+      ENDIF
+    ENDDO
+
+    !! 1.2.2 Vegetation and interception loss
+    !! \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
+        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,:))
+
+          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
+
+
+END MODULE diffuco
Index: /branches/publications/ORCHIDEE-AFP/src_sechiba/enerbil.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/enerbil.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/enerbil.f90	(revision 8430)
@@ -0,0 +1,1593 @@
+!  ==============================================================================================================================
+!  MODULE		 			: enerbil
+!
+!  CONTACT		 			: orchidee-help _at_ listes.ipsl.fr
+!
+!  LICENCE	 			        : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF					This module computes the energy balance on 
+!! continental surfaces. The module contains the following subroutines: enerbil_initialize, enerbil_main,
+!! enerbil_clear, enerbil_begin, enerbil_surftemp, enerbil_flux and enerbil_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 time, ONLY : one_day, dt_sechiba
+  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
+
+  ! variables used inside enerbil module : declaration and initialisation
+ 
+  ! one dimension array allocated, computed and used in enerbil module exclusively
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psold         !! Old surface dry static energy (J kg^{-1})
+!$OMP THREADPRIVATE(psold)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat      !! Saturated specific humudity for old temperature (kg kg^{-1})
+!$OMP THREADPRIVATE(qsol_sat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pdqsold       !! Deriv. of saturated specific humidity at old temp
+                                                                 !! (kg (kg s)^{-1})
+!$OMP THREADPRIVATE(pdqsold)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psnew         !! New surface static energy (J kg^{-1})
+!$OMP THREADPRIVATE(psnew)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat_new  !! New saturated surface air moisture (kg kg^{-1})
+!$OMP THREADPRIVATE(qsol_sat_new)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: netrad        !! Net radiation (W m^{-2})
+!$OMP THREADPRIVATE(netrad)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwabs         !! LW radiation absorbed by the surface (W m^{-2})
+!$OMP THREADPRIVATE(lwabs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwup          !! Long-wave up radiation (W m^{-2})
+!$OMP THREADPRIVATE(lwup)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwnet         !! Net Long-wave radiation (W m^{-2})
+!$OMP THREADPRIVATE(lwnet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: fluxsubli     !! Energy of sublimation (mm day^{-1})
+!$OMP THREADPRIVATE(fluxsubli)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsat_air      !! Air saturated specific humidity (kg kg^{-1})
+!$OMP THREADPRIVATE(qsat_air)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tair          !! Air temperature (K)
+!$OMP THREADPRIVATE(tair)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: q_sol_pot               !! Potential surface humidity
+!$OMP THREADPRIVATE(q_sol_pot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: temp_sol_pot            !! Potential surface temperature (unstressed)
+!$OMP THREADPRIVATE(temp_sol_pot)
+
+  
+CONTAINS  
+!!  =============================================================================================================================
+!! SUBROUTINE:              enerbil_initialize
+!!
+!>\BRIEF		    Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION:             The purpose of this module is, firstly, to allocate space
+!! in memory for key variables within the 'enerbil' module. The second task is to retrieve previous data
+!! from the restart file. If the variables are not in restart file, default initialization is done. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S): None
+!! 
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_initialize (kjit,     kjpindex,     index,    rest_id,  &
+                                 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)
+
+
+    !! 3. Diagnose 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)
+
+
+    !! 4. 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)
+
+
+    
+    !! 5. 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
+    REAL(r_std),DIMENSION (kjpindex) :: dtes        !! Diagnostic output variable for the change of the thermal energy content of surface for which the energy balance is calculated (J m-2)
+
+!_ ================================================================================================================================
+ 
+    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
+
+      ! Calculate dtes only for diagnostic output and send it to xios
+      dtes(ji) = (soilcap(ji)/cp_air)*dtheta/dt_sechiba
+
+    ENDDO
+
+    ! Send diagnostic variable to XIOS
+    CALL xios_orchidee_send_field("dtes", dtes)
+
+    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. min_sechiba) 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. min_sechiba) .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
+
+END MODULE enerbil
Index: /branches/publications/ORCHIDEE-AFP/src_sechiba/explicitsnow.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/explicitsnow.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/explicitsnow.f90	(revision 8430)
@@ -0,0 +1,1644 @@
+! ================================================================================================================================
+!  MODULE       : explicitsnow
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_day, dt_sechiba
+  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,    contfrac,              & ! 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
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)           :: contfrac         !! Fraction of continent in the grid
+
+    !! 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
+    REAL(r_std), DIMENSION (kjpindex)                        :: snowheattot_begin,snowheattot_end,del_snowheattot !![J/m2]
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: snowliq_diag         ! Snow liquid content per snow layer [kg/m2]
+    REAL(r_std), DIMENSION (kjpindex)                        :: snowliqtot_diag      ! Snow liquid content integrated over snow depth [kg/m2]
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: snowrho_diag
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: snowheat_diag
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: snowgrain_diag
+
+    !! 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
+    snowheattot_begin(:)=SUM(snowheat(:,:),2)
+    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
+          ! There is enough snow to split the sublimation demand between the nobio and vegetation parts.
+          IF (snow_nobio(ji,iice) .GE. vevapsno(ji)) THEN
+             ! There is enough snow on the ice fraction to sustain the sublimation demand.
+             subsnownobio(ji,iice) = frac_nobio(ji,iice)*vevapsno(ji)
+          ELSE
+             ! There is not enough snow on the ice fraction to sustain the full sublimation demand.
+             ! We take all the nobio snow and set the remaining sublimation demand on the vegetation fraction.
+             ! We do this because the nobio snow cannot deal with a too high sublimation demand, whereas the 
+             ! vegetation fraction can, through the subsinksoil variable (see below 2.8.1), which is taken into 
+             ! account in the water budget (see TWBR in hydrol.f90).
+             subsnownobio(ji,iice) = snow_nobio(ji,iice)
+          ENDIF
+          subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
+       ELSE
+          ! There is a small amount of snow.
+          IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+             ! The ice fraction is not too small. In this case, we make the hypothesis that the snow is mainly on the ice fraction.
+             IF (snow_nobio(ji,iice) .GE. vevapsno(ji)) THEN
+                ! There is enough snow on the ice fraction to sustain the sublimation demand.
+                subsnownobio(ji,iice) = vevapsno(ji)
+                subsnowveg(ji) = zero
+             ELSE
+                ! There is not enough snow on the ice fraction to sustain the sublimation demand.
+                ! We take all the nobio snow and set the remaining sublimation demand on the vegetation fraction.
+                ! We do this beacuse the nobio snow cannot deal with a too high sublimation demand, whereas the 
+                ! vegetation fraction can, through the subsinksoil variable (see below 2.8.1), which is taken into 
+                ! account in the water budget (see TWBR in hydrol.f90).
+                subsnownobio(ji,iice) = snow_nobio(ji,iice)
+                subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
+             ENDIF
+          ELSE
+             ! The nobio snow fraction is too small, the vegetation fraction deals with the whole sublimation demand.
+             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
+    snowheattot_end(:)=SUM(snowheat(:,:),2)
+    del_snowheattot(:)=snowheattot_end(:)-snowheattot_begin(:)
+    
+    !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 cannot give us negative snow_nobio (see 2.9).
+       
+       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
+
+    ! Add XIOS default value where no snow
+    DO ji=1,kjpindex 
+       IF (snow(ji) .GT. zero) THEN
+          ! Output for snowliq and snowliqtot change unit from m to kg/m2 and are multiplied by contfrac 
+          ! to take into acount the portion form land fraction only
+          snowliq_diag(ji,:) = snowliq(ji,:) * 1000 * contfrac(ji)
+          snowliqtot_diag(ji) = SUM(snowliq_diag(ji,:)) * 1000 * contfrac(ji)
+          snowrho_diag(ji,:) = snowrho(ji,:)
+          snowheat_diag(ji,:) = snowheat(ji,:)
+          snowgrain_diag(ji,:) = snowgrain(ji,:)
+       ELSE
+          snowliq_diag(ji,:) = xios_default_val
+          snowliqtot_diag(ji) = xios_default_val
+          snowrho_diag(ji,:) = xios_default_val
+          snowheat_diag(ji,:) = xios_default_val
+          snowgrain_diag(ji,:) = xios_default_val
+       END IF
+    END DO
+
+    CALL xios_orchidee_send_field("snowliq",snowliq_diag)
+    CALL xios_orchidee_send_field("snowliqtot", snowliqtot_diag)
+    CALL xios_orchidee_send_field("snowrho",snowrho_diag)
+    CALL xios_orchidee_send_field("snowheat",snowheat_diag)
+    CALL xios_orchidee_send_field("snowgrain",snowgrain_diag)
+    CALL xios_orchidee_send_field("snowmelt_from_maxmass",snowmelt_from_maxmass)
+    CALL xios_orchidee_send_field("soilcap",soilcap)
+    CALL xios_orchidee_send_field("del_snowheattot",del_snowheattot)
+
+  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-AFP/src_sechiba/hydrol.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/hydrol.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/hydrol.f90	(revision 8430)
@@ -0,0 +1,7111 @@
+! ===================================================================================================\n
+! MODULE        : hydrol
+!
+! CONTACT       : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module computes the soil moisture processes on continental points. 
+!!
+!!\n DESCRIPTION : contains hydrol_main, hydrol_initialize, hydrol_finalise, hydrol_init, 
+!!                 hydrol_var_init, hydrol_waterbal, hydrol_alma,
+!!                 hydrol_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 time, ONLY : one_day, dt_sechiba, julian_diff
+  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                                   :: 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 
+                                                                               !! (true/false)
+!$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 (:)   :: mcfc                !! Volumetric water content at field capacity
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mcfc)                                                 
+  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+Totmelt per PFT 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(precisol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: throughfall      !! Throughfall per PFT 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(throughfall)
+  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)
+
+!! for output
+  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 (:,:)    :: avan_mod_tab  !! VG parameter a modified from  exponantial profile
+                                                                      !! @tex $(mm^{-1})$ @endtex !! DIMENSION (nslm,nscm)
+!$OMP THREADPRIVATE(avan_mod_tab)  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: nvan_mod_tab  !! VG parameter n  modified from  exponantial profile
+                                                                      !! (unitless) !! DIMENSION (nslm,nscm)  
+!$OMP THREADPRIVATE(nvan_mod_tab)
+  
+!! 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 (:,:)    :: 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 content at residual per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmcr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcs             !! Total moisture content at saturation per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmcs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcfc            !! Total moisture content at field capacity per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmcfc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcw             !! Total moisture content at wilting point per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmcw)
+  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 (:,:,:) :: mc_read_prev       !! Soil moisture from file at previous timestep in the file
+!$OMP THREADPRIVATE(mc_read_prev)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_next       !! Soil moisture from file at next time step in the file
+!$OMP THREADPRIVATE(mc_read_next)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_current    !! For nudging, linear time interpolation bewteen mc_read_prev and mc_read_next
+!$OMP THREADPRIVATE(mc_read_current)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mask_mc_interp     !! Mask of valid data in soil moisture nudging file
+!$OMP THREADPRIVATE(mask_mc_interp)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)   :: tmc_aux            !! Temporary variable needed for the calculation of diag nudgincsm for nudging
+!$OMP THREADPRIVATE(tmc_aux)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)   :: snowdz_read_prev   !! snowdz read from file at previous timestep in the file
+!$OMP THREADPRIVATE(snowdz_read_prev)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)   :: snowdz_read_next   !! snowdz read from file at next time step in the file
+!$OMP THREADPRIVATE(snowdz_read_next)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)   :: snowrho_read_prev  !! snowrho read from file at previous timestep in the file
+!$OMP THREADPRIVATE(snowrho_read_prev)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)   :: snowrho_read_next  !! snowrho read from file at next time step in the file
+!$OMP THREADPRIVATE(snowrho_read_next)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)   :: snowtemp_read_prev !! snowtemp read from file at previous timestep in the file
+!$OMP THREADPRIVATE(snowtemp_read_prev)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)   :: snowtemp_read_next !! snowtemp read from file at next time step in the file
+!$OMP THREADPRIVATE(snowtemp_read_next)
+   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)   :: mask_snow_interp   !! Mask of valid data in snow nudging file
+!$OMP THREADPRIVATE(mask_snow_interp)
+
+   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 (:,:)    :: soilmoist_liquid !! (:,nslm) Mean of each soil layer's liquid moisture
+                                                                         !! across soiltiles
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(soilmoist_liquid)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: soil_wet_ns      !! Soil wetness above mcw (0-1, unitless)
+!$OMP THREADPRIVATE(soil_wet_ns)
+  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
+                                                                         !! (at lower interface)
+!$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 (:,:)    :: profil_froz_hydro     !! Frozen fraction for each hydrological soil layer
+!$OMP THREADPRIVATE(profil_froz_hydro)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: profil_froz_hydro_ns  !! As  profil_froz_hydro per soiltile
+!$OMP THREADPRIVATE(profil_froz_hydro_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: temp_hydro            !! Temp profile on hydrological levels
+!$OMP THREADPRIVATE(temp_hydro)
+
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_initialize
+!!
+!>\BRIEF         Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION :
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_initialize ( kjit,           kjpindex,  index,         rest_id,          &
+                                 njsc,           soiltile,  veget,         veget_max,        &
+                                 humrel,         vegstress, drysoil_frac,                    &
+                                 shumdiag_perma,    qsintveg,                        &
+                                 evap_bare_lim,  snow,      snow_age,      snow_nobio,       &
+                                 snow_nobio_age, snowrho,   snowtemp,      snowgrain,        &
+                                 snowdz,         snowheat,  &
+                                 mc_layh,        mcl_layh,  soilmoist_out, &
+                                 swdown)!!xchen add swdown liuly
+
+    !! 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,nslm), 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)  :: soilmoist_out  !! Total soil moisture content for each layer in hydrol (liquid+ice), mm
+    REAL(r_std),DIMENSION (kjpindex)                     :: soilwetdummy   !! Temporary variable never used
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: swdown         !!xchen Down-welling surface short-wave flux 
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                       :: jsl
+!_ ================================================================================================================================
+
+    CALL hydrol_init (kjit, kjpindex, index, rest_id, veget_max, soiltile, &
+         humrel, vegstress, snow,       snow_age,   snow_nobio, snow_nobio_age, qsintveg, &
+         snowdz, snowgrain, snowrho,    snowtemp,   snowheat, &
+         drysoil_frac, evap_bare_lim)
+    
+    CALL hydrol_var_init (kjpindex, veget, veget_max, &
+         soiltile, njsc, mx_eau_var, shumdiag_perma, &
+         drysoil_frac, qsintveg, mc_layh, mcl_layh, swdown) !!xchen add swdown
+
+    !! 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
+
+    ! Copy soilmoist into a local variable to be sent to thermosoil
+    soilmoist_out(:,:) = soilmoist(:,:)
+
+  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, indexnslm, &
+       & 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, fraclut, reinf_slope, rest_id, hist_id, hist2_id,&
+       & contfrac, 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,frac_snow_veg,temp_sol_add, &
+       & mc_layh, mcl_layh, soilmoist_out,swdown)!!xchen add swdown
+
+    !! 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):: indexnslm      !! 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,nlut), INTENT (in) :: fraclut          !! Fraction of each landuse tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vevapwet         !! Interception loss
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type           
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI -> infty)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintmax         !! Maximum water on vegetation for interception
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: transpir         !! Transpiration
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: reinf_slope      !! Slope coef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot           !! Soil Potential Evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot_penm      !! Soil Potential Evaporation Correction
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_frac       !! flood fraction
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: contfrac         !! Fraction of continent in the grid
+    REAL(r_std),DIMENSION (kjpindex,nslm), 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), INTENT(in)       :: frac_snow_veg    !! Snow cover fraction on vegetation  
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swdown           !!xchen Down-welling surface short-wave flux   
+
+    !! 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,nslm), INTENT (out):: shumdiag         !! Relative soil moisture in each soil layer 
+                                                                           !! with respect to (mcfc-mcw)
+                                                                           !! (unitless; can be out of 0-1)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out):: shumdiag_perma   !! Percent of porosity filled with water (mc/mcs) used for the thermal computations 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: k_litt           !! litter approximate conductivity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: litterhumdiag    !! litter humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: tot_melt         !! Total melt    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: floodout         !! Flux out of floodplains
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: qsintveg         !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)    :: evap_bare_lim    !! Limitation factor (beta) for bare soil evaporation    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: humrel           !! Relative humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapnu          !! Bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapsno         !! Snow evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapflo         !! Floodplain evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: flood_res        !! flood reservoir estimate
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: snow             !! Snow mass [kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio  !! Water balance on ice, lakes, .. [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age !! Snow age on ice, lakes, ...
+    !! We consider that any water on the ice is snow and we only peforme a water balance to have consistency.
+    !! The water balance is limite to + or - 10^6 so that accumulation is not endless
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: runoff       !! Complete surface runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: drainage     !! Drainage
+    REAL(r_std), DIMENSION (kjpindex,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)     :: soilmoist_out!! 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)                   :: snowdepth_diag   !! Depth of snow layer containing default values, only for diagnostics
+    REAL(r_std),DIMENSION (kjpindex, nsnow)            :: snowdz_diag      !! Depth of snow layer on all layers containing default values, only for diagnostics
+    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 mean of mcs
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_mcfc        !! To ouput the mean of mcfc 
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_mcw         !! To ouput the mean of mcw 
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_mcr         !! To ouput the mean of mcr 
+    REAL(r_std),DIMENSION (kjpindex)                   :: land_tmcs        !! To ouput the grid-cell mean of tmcs 
+    REAL(r_std),DIMENSION (kjpindex)                   :: land_tmcfc       !! To ouput the grid-cell mean of tmcfc
+    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]
+    REAL(r_std),DIMENSION (kjpindex)                   :: mrsow            !! Soil wetness above wilting point for CMIP6 (humtot-WP)/(SAT-WP)
+    REAL(r_std), DIMENSION (kjpindex,nlut)             :: humtot_lut       !! Moisture content on landuse tiles, for diagnostics
+    REAL(r_std), DIMENSION (kjpindex,nlut)             :: humtot_top_lut   !! Moisture content in upper layers on landuse tiles, for diagnostics
+    REAL(r_std), DIMENSION (kjpindex,nlut)             :: mrro_lut         !! Total runoff from landuse tiles, for diagnostics
+
+!_ ================================================================================================================================
+    !! 1. Update vegtot_old and recalculate vegtot
+    vegtot_old(:) = vegtot(:)
+
+    DO ji = 1, kjpindex
+       vegtot(ji) = SUM(veget_max(ji,:))
+    ENDDO
+
+
+    !! 2. Applay nudging for soil moisture and/or snow variables
+
+    ! For soil moisture, here only read and interpolate the soil moisture from file to current time step. 
+    ! The values will be applayed in hydrol_soil after the soil moisture has been updated. 
+    IF (ok_nudge_mc) THEN
+       CALL hydrol_nudge_mc_read(kjit)
+    END IF
+
+    ! Read, interpolate and applay nudging of snow variables
+    IF ( ok_nudge_snow) THEN
+     CALL hydrol_nudge_snow(kjit, kjpindex, snowdz, snowrho, snowtemp )
+    END IF
+
+
+    !! 3. Shared time step
+    IF (printlev>=3) WRITE (numout,*) 'hydrol pas de temps = ',dt_sechiba
+
+    ! 
+    !! 3.1 Calculate snow processes with explicit 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,    contfrac,              & 
+         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, swdown) !!xchen add swdown
+
+    ! The update fluxes come from hydrol_vegupd
+    drainage(:) =  drainage(:) +  drain_upd(:)
+    runoff(:) =  runoff(:) +  runoff_upd(:)
+
+
+    !! 4 write out file  ==> hydrol_alma/histwrite(*)
+    !
+    ! If we use the ALMA standards
+    CALL hydrol_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet)
+    
+
+    ! Calculate 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)
+    CALL xios_orchidee_send_field("undermcr",undermcr) ! nb of tiles undermcr at end of timestep
+
+    ! 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)
+
+    ! Particular soil moisture values, spatially averaged over the grid-cell
+    ! (a) total SM in kg/m2
+    !     we average the total values of each soiltile and multiply by vegtot to transform to a grid-cell mean (over total land)
+    land_tmcs(:) = zero
+    land_tmcfc(:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          land_tmcs(ji) = land_tmcs(ji) + soiltile(ji,jst) * tmcs(ji,jst) * vegtot(ji)
+          land_tmcfc(ji) = land_tmcfc(ji) + soiltile(ji,jst) * tmcfc(ji,jst) * vegtot(ji)
+       ENDDO
+    ENDDO
+    CALL xios_orchidee_send_field("tmcs",land_tmcs) ! in kg/m2
+    CALL xios_orchidee_send_field("tmcfc",land_tmcfc) ! in kg/m2
+
+    ! (b) volumetric moisture content by layers in m3/m3
+    !     mcs etc are identical in all layers (no normalization by vegtot to be comparable to mc)
+    DO jsl=1,nslm
+       land_mcs(:,jsl) = mcs(njsc(:))
+       land_mcfc(:,jsl) = mcfc(njsc(:))
+       land_mcw(:,jsl) = mcw(njsc(:))
+       land_mcr(:,jsl) = mcr(njsc(:))
+    ENDDO
+    CALL xios_orchidee_send_field("mcs",land_mcs) ! in m3/m3
+    CALL xios_orchidee_send_field("mcfc",land_mcfc) ! in m3/m3 
+    CALL xios_orchidee_send_field("mcw",land_mcw) ! in m3/m3 
+    CALL xios_orchidee_send_field("mcr",land_mcr) ! 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("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("throughfall",throughfall/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(throughfall(:,:),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("soilmoist_liquid",soilmoist_liquid)
+    CALL xios_orchidee_send_field("humtot_frozen",SUM(soilmoist(:,:),2)-SUM(soilmoist_liquid(:,:),2))
+    CALL xios_orchidee_send_field("tmc",tmc)
+    CALL xios_orchidee_send_field("humtot",humtot)
+    CALL xios_orchidee_send_field("humtot_top",humtot_top)
+
+    ! For the soil wetness above wilting point for CMIP6 (mrsow)
+    mrsow(:) = MAX( zero,humtot(:) - zmaxh*mille*mcw(njsc(:)) ) &
+         / ( zmaxh*mille*( mcs(njsc(:)) - mcw(njsc(:)) ) )
+    CALL xios_orchidee_send_field("mrsow",mrsow)
+
+
+    
+    ! Prepare diagnostic snow variables
+    !  Add XIOS default value where no snow
+    DO ji=1,kjpindex
+       IF (snow(ji) > 0) THEN
+          snowdz_diag(ji,:) = snowdz(ji,:)
+          snowdepth_diag(ji) = SUM(snowdz(ji,:))*(1-totfrac_nobio(ji))*frac_snow_veg(ji)
+       ELSE
+          snowdz_diag(ji,:) = xios_default_val
+          snowdepth_diag(ji) = xios_default_val             
+       END IF
+    END DO
+    CALL xios_orchidee_send_field("snowdz",snowdz_diag)
+    CALL xios_orchidee_send_field("snowdepth",snowdepth_diag)
+
+    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)
+    END IF
+    CALL xios_orchidee_send_field("profil_froz_hydro_ns", profil_froz_hydro_ns)
+    CALL xios_orchidee_send_field("kk_moy",kk_moy) ! in mm/d
+
+
+    !! Calculate diagnostic variables on Landuse tiles for LUMIP/CMIP6
+    humtot_lut(:,:)=0
+    humtot_top_lut(:,:)=0
+    mrro_lut(:,:)=0
+    DO jv=1,nvm
+       jst=pref_soil_veg(jv) ! soil tile index
+       IF (natural(jv)) THEN
+          humtot_lut(:,id_psl) = humtot_lut(:,id_psl) + tmc(:,jst)*veget_max(:,jv)
+          humtot_top_lut(:,id_psl) = humtot_top_lut(:,id_psl) + tmc_top(:,jst)*veget_max(:,jv)
+          mrro_lut(:,id_psl) = mrro_lut(:,id_psl) + (dr_ns(:,jst)+ru_ns(:,jst))*veget_max(:,jv)
+       ELSE
+          humtot_lut(:,id_crp) = humtot_lut(:,id_crp) + tmc(:,jst)*veget_max(:,jv)
+          humtot_top_lut(:,id_crp) = humtot_top_lut(:,id_crp) + tmc_top(:,jst)*veget_max(:,jv)
+          mrro_lut(:,id_crp) = mrro_lut(:,id_crp) + (dr_ns(:,jst)+ru_ns(:,jst))*veget_max(:,jv)
+       ENDIF
+    END DO
+
+    WHERE (fraclut(:,id_psl)>min_sechiba)
+       humtot_lut(:,id_psl) = humtot_lut(:,id_psl)/fraclut(:,id_psl)
+       humtot_top_lut(:,id_psl) = humtot_top_lut(:,id_psl)/fraclut(:,id_psl)
+       mrro_lut(:,id_psl) = mrro_lut(:,id_psl)/fraclut(:,id_psl)/dt_sechiba
+    ELSEWHERE
+       humtot_lut(:,id_psl) = val_exp
+       humtot_top_lut(:,id_psl) = val_exp
+       mrro_lut(:,id_psl) = val_exp
+    END WHERE
+    WHERE (fraclut(:,id_crp)>min_sechiba)
+       humtot_lut(:,id_crp) = humtot_lut(:,id_crp)/fraclut(:,id_crp)
+       humtot_top_lut(:,id_crp) = humtot_top_lut(:,id_crp)/fraclut(:,id_crp)
+       mrro_lut(:,id_crp) = mrro_lut(:,id_crp)/fraclut(:,id_crp)/dt_sechiba
+    ELSEWHERE
+       humtot_lut(:,id_crp) = val_exp
+       humtot_top_lut(:,id_crp) = val_exp
+       mrro_lut(:,id_crp) = val_exp
+    END WHERE
+
+    humtot_lut(:,id_pst) = val_exp
+    humtot_lut(:,id_urb) = val_exp
+    humtot_top_lut(:,id_pst) = val_exp
+    humtot_top_lut(:,id_urb) = val_exp
+    mrro_lut(:,id_pst) = val_exp
+    mrro_lut(:,id_urb) = val_exp
+
+    CALL xios_orchidee_send_field("humtot_lut",humtot_lut)
+    CALL xios_orchidee_send_field("humtot_top_lut",humtot_top_lut)
+    CALL xios_orchidee_send_field("mrro_lut",mrro_lut)
+
+    ! Write diagnistic for soil moisture nudging
+    IF (ok_nudge_mc) CALL hydrol_nudge_mc_diag(kjpindex, soiltile)
+
+
+    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(throughfall(:,:),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*nslm,indexnslm)
+
+       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)
+       
+       CALL histwrite_p(hist_id, 'temp_hydro', kjit,temp_hydro , kjpindex*nslm, indexlayer)
+    ENDIF
+    CALL histwrite_p(hist_id, 'kk_moy', kjit, kk_moy,kjpindex*nslm, indexlayer) ! averaged over soiltiles
+    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
+
+    ! Copy soilmoist into a local variable to be sent to thermosoil
+    soilmoist_out(:,:) = soilmoist(:,:)
+
+    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 '
+
+    DO jst=1,nstm
+       ! var_name= "mc_1" ... "mc_3"
+       WRITE (var_name,"('moistc_',i1)") jst
+       CALL restput_p(rest_id, var_name, nbp_glo,  nslm, 1, kjit, mc(:,:,jst), 'scatter',  nbp_glo, index_g)
+    END DO
+
+    DO jst=1,nstm
+       ! var_name= "mcl_1" ... "mcl_3"
+       WRITE (var_name,"('moistcl_',i1)") jst
+       CALL restput_p(rest_id, var_name, nbp_glo,  nslm, 1, kjit, mcl(:,:,jst), 'scatter',  nbp_glo, index_g)
+    END DO
+    
+    IF (ok_nudge_mc) THEN
+       DO jst=1,nstm
+          WRITE (var_name,"('mc_read_next_',i1)") jst
+          CALL restput_p(rest_id, var_name, nbp_glo,  nslm, 1, kjit, mc_read_next(:,:,jst), 'scatter',  nbp_glo, index_g)
+       END DO
+    END IF
+
+    IF (ok_nudge_snow) THEN
+       CALL restput_p(rest_id, 'snowdz_read_next', nbp_glo,  nsnow, 1, kjit, snowdz_read_next(:,:), &
+            'scatter',  nbp_glo, index_g)
+       CALL restput_p(rest_id, 'snowrho_read_next', nbp_glo,  nsnow, 1, kjit, snowrho_read_next(:,:), &
+            'scatter',  nbp_glo, index_g)
+       CALL restput_p(rest_id, 'snowtemp_read_next', nbp_glo,  nsnow, 1, kjit, snowtemp_read_next(:,:), &
+            'scatter',  nbp_glo, index_g)
+    END IF
+
+
+            
+    DO jst=1,nstm
+       DO jsl=1,nslm
+          ! var_name= "us_1_01" ... "us_3_11"
+          WRITE (var_name,"('us_',i1,'_',i2.2)") jst,jsl
+          CALL restput_p(rest_id, var_name, nbp_glo,nvm, 1,kjit,us(:,:,jst,jsl),'scatter',nbp_glo,index_g)
+       END DO
+    END DO
+    
+    CALL restput_p(rest_id, 'free_drain_coef', nbp_glo,   nstm, 1, kjit,  free_drain_coef, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, '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, veget_max, soiltile, &
+       humrel,  vegstress, snow,       snow_age,   snow_nobio, snow_nobio_age, qsintveg, &
+       snowdz,  snowgrain, snowrho,    snowtemp,   snowheat, &
+       drysoil_frac, evap_bare_lim)
+    
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number 
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! _Restart_ file identifier 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max          !! Carte de vegetation max
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)  :: soiltile           !! Fraction of each soil tile 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
+
+    ALLOCATE (nvan(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nvan','','')
+
+    ALLOCATE (avan(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable avan','','')
+
+    ALLOCATE (mcr(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcr','','')
+
+    ALLOCATE (mcs(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcs','','')
+
+    ALLOCATE (ks(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ks','','')
+
+    ALLOCATE (pcent(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable pcent','','')
+
+    ALLOCATE (mcfc(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcfc','','')
+
+    ALLOCATE (mcw(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcw','','')
+    
+    ALLOCATE (mc_awet(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_awet','','')
+
+    ALLOCATE (mc_adry(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_adry','','')
+       
+    !!__2.2 Soil texture choose
+
+    SELECTCASE (nscm)
+    CASE (3)
+              
+       nvan(:) = nvan_fao(:)       
+       avan(:) = avan_fao(:)
+       mcr(:) = mcr_fao(:)
+       mcs(:) = mcs_fao(:)
+       ks(:) = ks_fao(:)
+       pcent(:) = pcent_fao(:)
+       mcfc(:) = 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(:)
+       mcfc(:) = 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",mcfc)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcfc(:) > 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(:) > mcfc(:)) .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 (throughfall(kjpindex,nvm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable throughfall','','')
+
+    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','','')
+
+    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
+    
+    ALLOCATE (avan_mod_tab(nslm,nscm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable avan_mod_tab','','')
+    
+    ALLOCATE (nvan_mod_tab(nslm,nscm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nvan_mod_tab','','')
+
+    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 (tmcfc(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcfc','','')
+
+    ALLOCATE (tmcw(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcw','','')
+
+    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','','')
+
+
+    ! Variables for nudging of soil moisture
+    IF (ok_nudge_mc) THEN
+       ALLOCATE (mc_read_prev(kjpindex,nslm,nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_prev','','')
+       ALLOCATE (mc_read_next(kjpindex,nslm,nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_next','','')
+       ALLOCATE (mc_read_current(kjpindex,nslm,nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_current','','')
+       ALLOCATE (mask_mc_interp(kjpindex,nslm,nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_mc_interp','','')
+       ALLOCATE (tmc_aux(kjpindex,nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_aux','','')
+    END IF
+
+    ! Variables for nudging of snow variables
+    IF (ok_nudge_snow) THEN
+       ALLOCATE (snowdz_read_prev(kjpindex,nsnow),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowdz_read_prev','','')
+       ALLOCATE (snowdz_read_next(kjpindex,nsnow),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowdz_read_next','','')
+       
+       ALLOCATE (snowrho_read_prev(kjpindex,nsnow),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowrho_read_prev','','')
+       ALLOCATE (snowrho_read_next(kjpindex,nsnow),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowrho_read_next','','')
+       
+       ALLOCATE (snowtemp_read_prev(kjpindex,nsnow),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowtemp_read_prev','','')
+       ALLOCATE (snowtemp_read_next(kjpindex,nsnow),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowtemp_read_next','','')
+       
+       ALLOCATE (mask_snow_interp(kjpindex,nsnow),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_snow_interp','','')
+    END IF
+
+    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 (soilmoist(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist','','')
+
+    ALLOCATE (soilmoist_liquid(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist_liquid','','')
+
+    ALLOCATE (soil_wet_ns(kjpindex,nslm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet_ns','','')
+
+    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', '-')
+       !
+       DO jst=1,nstm
+          ! var_name= "mc_1" ... "mc_3"
+           WRITE (var_name,"('moistc_',I1)") jst
+           IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+           CALL restget_p (rest_id, var_name, nbp_glo, nslm , 1, kjit, .TRUE., mc(:,:,jst), "gather", nbp_glo, index_g)
+       END DO
+
+       IF (ok_nudge_mc) THEN
+          DO jst=1,nstm
+             WRITE (var_name,"('mc_read_next_',I1)") jst
+             IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME','Soil moisture read from nudging file')
+             CALL restget_p (rest_id, var_name, nbp_glo, nslm , 1, kjit, .TRUE., mc_read_next(:,:,jst), &
+                  "gather", nbp_glo, index_g)
+          END DO
+       END IF
+
+       IF (ok_nudge_snow) THEN
+          IF (is_root_prc) THEN
+             CALL ioconf_setatt_p('UNITS', 'm')
+             CALL ioconf_setatt_p('LONG_NAME','Snow layer thickness read from nudging file')
+          ENDIF
+          CALL restget_p (rest_id, 'snowdz_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowdz_read_next, &
+               "gather", nbp_glo, index_g)
+
+          IF (is_root_prc) THEN
+             CALL ioconf_setatt_p('UNITS', 'kg/m^3')
+             CALL ioconf_setatt_p('LONG_NAME','Snow density profile read from nudging file')
+          ENDIF
+          CALL restget_p (rest_id, 'snowrho_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowrho_read_next, &
+               "gather", nbp_glo, index_g)
+
+          IF (is_root_prc) THEN
+             CALL ioconf_setatt_p('UNITS', 'K')
+             CALL ioconf_setatt_p('LONG_NAME','Snow temperature read from nudging file')
+          ENDIF
+          CALL restget_p (rest_id, 'snowtemp_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowtemp_read_next, &
+               "gather", nbp_glo, index_g)
+       END IF
+      
+       DO jst=1,nstm
+          ! var_name= "mcl_1" ... "mcl_3"
+           WRITE (var_name,"('moistcl_',I1)") jst
+           IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+           CALL restget_p (rest_id, var_name, nbp_glo, nslm , 1, kjit, .TRUE., mcl(:,:,jst), "gather", nbp_glo, index_g)
+       END DO
+
+       IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+       DO jst=1,nstm
+          DO jsl=1,nslm
+             ! var_name= "us_1_01" ... "us_3_11"
+             WRITE (var_name,"('us_',i1,'_',i2.2)") jst,jsl
+             IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., us(:,:,jst,jsl), "gather", nbp_glo, index_g)
+          END DO
+       END DO
+       !
+       var_name= 'free_drain_coef'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Coefficient for free drainage at bottom of soil')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., free_drain_coef, "gather", nbp_glo, index_g)
+       !
+       var_name= '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= 'vegtot_old'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','vegtot from previous time-step')
+       ENDIF
+       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 previous time-step. 
+       ! This is because hydrol_main is done before veget_max is updated in 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)
+
+
+    ! Initialize soil moisture for nudging if not found in restart file
+    IF (ok_nudge_mc) THEN
+       IF ( ALL(mc_read_next(:,:,:)==val_exp) ) mc_read_next(:,:,:) = mc(:,:,:)
+    END IF
+    
+    ! Initialize snow variables for nudging if not found in restart file
+    IF (ok_nudge_snow) THEN
+       IF ( ALL(snowdz_read_next(:,:)==val_exp) ) snowdz_read_next(:,:) = snowdz(:,:)
+       IF ( ALL(snowrho_read_next(:,:)==val_exp) ) snowrho_read_next(:,:) = snowrho(:,:)
+       IF ( ALL(snowtemp_read_next(:,:)==val_exp) ) snowtemp_read_next(:,:) = snowtemp(:,:)
+    END IF
+    
+    
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_init done '
+    
+  END SUBROUTINE hydrol_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_clear
+!!
+!>\BRIEF        Deallocate arrays 
+!!
+!_ ================================================================================================================================
+!_ hydrol_clear
+
+  SUBROUTINE hydrol_clear()
+
+    ! Allocation for soiltile related parameters
+    IF ( ALLOCATED (nvan)) DEALLOCATE (nvan)
+    IF ( ALLOCATED (avan)) DEALLOCATE (avan)
+    IF ( ALLOCATED (mcr)) DEALLOCATE (mcr)
+    IF ( ALLOCATED (mcs)) DEALLOCATE (mcs)
+    IF ( ALLOCATED (ks)) DEALLOCATE (ks)
+    IF ( ALLOCATED (pcent)) DEALLOCATE (pcent)
+    IF ( ALLOCATED (mcfc)) DEALLOCATE (mcfc)
+    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  (throughfall)) DEALLOCATE (throughfall)
+    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  (avan_mod_tab)) DEALLOCATE (avan_mod_tab)
+    IF (ALLOCATED  (nvan_mod_tab)) DEALLOCATE (nvan_mod_tab)
+    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  (tmcfc)) DEALLOCATE (tmcfc)
+    IF (ALLOCATED  (tmcw)) DEALLOCATE (tmcw)
+    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  (soilmoist_liquid)) DEALLOCATE (soilmoist_liquid)
+    IF (ALLOCATED  (soil_wet_ns)) DEALLOCATE (soil_wet_ns)
+    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)
+
+  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
+       vmr(:,:) = soiltile(:,:) - resdist(:,:)  ! resdist is the previous values of soiltiles, previous timestep, so before new map
+
+       ! 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) < -min_sechiba ) 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) < -min_sechiba ) 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) > min_sechiba ) 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) > min_sechiba ) 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 (i.e. total land)
+       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 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, swdown) !!xchen add swdown
+
+    ! 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)
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: swdown        !!xchen Down-welling surface short-wave flux 
+
+    !! 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,nslm), 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]
+
+    !! 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             !! 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)              :: alphavg         !! VG param a modified with depth at each node
+                                                                           !! @tex $(mm^{-1})$ @endtexe
+    REAL(r_std), DIMENSION (kjpindex,nslm)              :: nvg             !! VG param n modified with depth at each node
+                                                                           !! (unitless)
+    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.0
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [-]
+    n0 = 0.0
+    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.0
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [-]
+    nk_rel = 0.0
+    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.0
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [1/mm]
+    a0 = 0.0
+    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.0
+    !Config If    = 
+    !Config Help  =
+    !Config Units = [-]
+    ak_rel = 0.0
+    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
+         !! liulyq here are some diff with xchen, what it is?
+             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
+    END IF
+
+    !-
+    !! 3 Compute the profile for 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
+       !!   The effect of kfact_root on ks thus on k, a, n and d, is taken into account further in the code,
+       !!   in hydrol_soil_coef.
+       !-
+       ! 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
+          ! Creation of arrays for SP-MIP output by landpoint
+          nvan_mod_tab(jsl,jsc) = nvan_mod
+          avan_mod_tab(jsl,jsc) = avan_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
+
+    ! Output of alphavg and nvg at each node for SP-MIP
+    DO jsl = 1, nslm
+       alphavg(:,jsl) = avan_mod_tab(jsl,njsc(:))*1000. ! from mm-1 to m-1
+       nvg(:,jsl) = nvan_mod_tab(jsl,njsc(:))
+    ENDDO
+    CALL xios_orchidee_send_field("alphavg",alphavg) ! in m-1
+    CALL xios_orchidee_send_field("nvg",nvg) ! unitless
+
+    !! 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))
+          tmcfc(ji,jst)=zmaxh* mille*mcfc(njsc(ji))
+          tmcw(ji,jst)=zmaxh* mille*mcw(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*mcl(ji,1,jst)+mcl(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) * mcfc(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*mcl(ji,jsl,jst) + mcl(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mcl(ji,jsl,jst) + mcl(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))* & 
+                  & mcfc(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
+
+
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          ! here we set that humrelv=0 in PFT1
+          humrelv(ji,1,jst) = zero
+       ENDDO
+    END DO
+
+
+    ! Calculate shumdiag_perma for thermosoil
+    ! 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 jsl = 1, nslm
+       DO ji=1,kjpindex        
+          shumdiag_perma(ji,jsl) = soilmoist(ji,jsl) / (dh(jsl)*mcs(njsc(ji)))
+          shumdiag_perma(ji,jsl) = MAX(MIN(shumdiag_perma(ji,jsl), 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. 
+    ! These values are only used in thermosoil_init in absence of a restart file
+    mc_layh(:,:) = zero
+    mcl_layh(:,:) = zero
+    DO jst=1,nstm
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+            mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * resdist(ji,jst)  * vegtot_old(ji)
+            mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * resdist(ji,jst) * vegtot_old(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+Totmelt)
+
+    !! 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
+        
+    ! Precisol is currently the same as throughfall, save it for diagnostics
+    throughfall(:,:) = precisol(:,:)
+
+    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
+!!
+!! 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,swdown)!! xchen add swdown
+    ! 
+    ! 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,nslm), 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), INTENT (in)            :: swdown           !!xchen Down-welling surface short-wave flux  
+
+    !! 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,nslm), INTENT (out)     :: shumdiag         !! Relative soil moisture in each diag soil layer 
+                                                                                 !! with respect to (mcfc-mcw) (unitless, [0-1])
+    REAL(r_std), DIMENSION (kjpindex,nslm), 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 
+
+    !! 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)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji, jv, jsl, jst           !! Indices
+    REAL(r_std), PARAMETER                         :: frac_mcs = 0.66            !! Temporary depth
+    REAL(r_std), 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)
+
+    ! For the calculation of soil_wet_ns and us/humrel/vegstress 
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: sm                         !! Soil moisture of each layer (liquid phase)
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: smt                        !! Soil moisture of each layer (liquid+solid phase)
+                                                                                 !!  @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
+
+    ! For CMIP6 and SP-MIP : ksat and matric pressure head psi(theta)
+    REAL(r_std)                                    :: mc_ratio, mvg, avg
+    REAL(r_std)                                    :: psi                        !! Matric head (per soil layer and soil tile) [mm=kg/m2]
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: psi_moy                    !! Mean matric head per soil layer [mm=kg/m2]  
+    REAL(r_std), DIMENSION (kjpindex,nslm)         :: ksat                       !! Saturated hydraulic conductivity at each node (mm/d)  
+
+!_ ================================================================================================================================
+
+    !! 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
+    kk(:,:,:) = zero
+    kk_moy(:,:) = zero
+    undermcr(:) = zero ! needs to be initialized outside from jst loop
+    ksat(:,:) = zero
+    psi_moy(:,:) = zero
+
+    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))
+    CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, evap_bare_lim, tot_bare_soil)
+    
+    !! 0.3 Common variables related to routing, with all return flow applied to the soil surface
+    ! 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.3bis Diagnostic of the matric potential used for redistribution by Richards/tridiag (in m)
+       !  We use VG relationship giving psi as a function of mc (mcl in our case)
+       !  With patches against numerical pbs when (mc_ratio - un) becomes very slightly negative (gives NaN) 
+       !  or if psi become too strongly negative (pbs with xios output)
+       DO jsl=1, nslm
+          DO ji = 1, kjpindex
+             IF (soiltile(ji,jst) .GT. zero) THEN
+                mvg = un - un / nvan_mod_tab(jsl,njsc(ji))
+                avg = avan_mod_tab(jsl,njsc(ji))*1000. ! to convert in m-1
+                mc_ratio = MAX( 10.**(-14*mvg), (mcl(ji,jsl,jst) - mcr(njsc(ji)))/(mcs(njsc(ji)) - mcr(njsc(ji))) )**(-un/mvg)
+                psi = - MAX(zero,(mc_ratio - un))**(un/nvan_mod_tab(jsl,njsc(ji))) / avg ! in m 
+                psi_moy(ji,jsl) = psi_moy(ji,jsl) + soiltile(ji,jst) * psi ! average across soil tiles
+             ENDIF
+          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.1 Optional nudging for soil moisture 
+       IF (ok_nudge_mc) THEN
+          CALL hydrol_nudge_mc(kjpindex, jst, mc)
+       END IF
+
+
+       !! 3.4.2 Optional block to force saturation below zwt_force
+       ! This block is not compatible with freezing; in this case, mcl must be corrected too
+       ! 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)
+       ! We exclude the frozen water from the calculation
+       DO ji=1,kjpindex
+          tmc_litter(ji,jst) = dz(2) * ( trois*mcl(ji,1,jst)+ mcl(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*mcl(ji,jsl,jst) + mcl(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mcl(ji,jsl,jst) + mcl(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+
+       ! Subsequent calculation of soil_wet_litter (tmc-tmcw)/(tmcfc-tmcw)
+       ! Based on liquid water content
+       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
+       smt(:,1) = dz(2) * (trois*mc(:,1,jst) + mc(:,2,jst))/huit
+       smw(:,1) = dz(2) * (quatre*mcw(njsc(:)))/huit
+       smf(:,1) = dz(2) * (quatre*mcfc(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
+          smt(:,jsl) = dz(jsl) * (trois*mc(:,jsl,jst)+mc(:,jsl-1,jst))/huit &
+               + dz(jsl+1) * (trois*mc(:,jsl,jst)+mc(:,jsl+1,jst))/huit
+          smw(:,jsl) = dz(jsl) * ( quatre*mcw(njsc(:)) )/huit &
+               + dz(jsl+1) * ( quatre*mcw(njsc(:)) )/huit
+          smf(:,jsl) = dz(jsl) * ( quatre*mcfc(njsc(:)) )/huit &
+               + dz(jsl+1) * ( quatre*mcfc(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  
+       smt(:,nslm) = dz(nslm) * (trois*mc(:,nslm,jst) + mc(:,nslm-1,jst))/huit      
+       smw(:,nslm) = dz(nslm) * (quatre*mcw(njsc(:)))/huit
+       smf(:,nslm) = dz(nslm) * (quatre*mcfc(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_ns 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
+       ! Based on liquid water content
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             soil_wet_ns(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
+       ! Based on liquid water content
+
+       ! -- 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(:))
+                           !!xchen liulyw
+                           IF (swdown(ji) .GT. 180) THEN
+                              nroot(ji,jv,jsl)= nroot_tmp(jsl)/SUM(nroot_tmp(:))
+                             !! nroot(ji,jv,jsl)= (nroot_tmp(jsl)+nroot_tmp(jsl-1)+nroot_tmp(jsl-2)+nroot_tmp(jsl-3))/SUM(nroot_tmp(:))
+                           ELSE
+                              nroot(ji,jv,jsl)= nroot_tmp(jsl)/SUM(nroot_tmp(:))
+                           !!   nroot(ji,jv,jsl)=nroot_tmp(jsl)/SUM(nroot_tmp(:))
+                           ENDIF
+                           !! liulyw above, xchen mod here but seems no changes
+                         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 mcfc
+                ! 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 independent from the porosity
+                ! at first order, thus independent from freezing.   
+                ! 26-07-2017: us and humrel now based on liquid soil moisture, so the stress is stronger
+                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_ns 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_ns(:,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. 
+       !! The multiplication by vegtot creates grid-cell average values
+       ! *** To be checked for consistency with the use of nobio properties in thermosoil
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             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
+       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 keep the specific value (no multiplication by vegtot)
+       DO ji = 1, kjpindex
+          kk_moy(ji,:) = kk_moy(ji,:) + soiltile(ji,jst) * k(ji,:) 
+          kk(ji,:,jst) = k(ji,:)
+       ENDDO
+       
+       !! 6.5 We also want to export ksat at each node for CMIP6
+       !  (In the output, done only once according to field_def_orchidee.xml; same averaging as for kk)
+       DO jsl = 1, nslm
+          ksat(:,jsl) = ksat(:,jsl) + soiltile(:,jst) * &
+               ( ks(njsc(:)) * kfact(jsl,njsc(:)) * kfact_root(:,jsl,jst) ) 
+       ENDDO
+              
+      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 (Sellers et al., 1992)
+             ! It is based on the liquid SM only, like for us and humrel
+             IF (do_rsoil) THEN
+                mc_rel(ji) = tmc_litter(ji,jst)/tmcs_litter(ji) ! tmc_litter based on mcl
+                ! 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) = evap_soil(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("ksat",ksat) ! mm/d (for CMIP6, once)
+    CALL xios_orchidee_send_field("psi_moy",psi_moy) ! mm (for SP-MIP)
+    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) ! s/m
+
+    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_ns 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_ns(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
+!_ ================================================================================================================================
+
+  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=(mcfc-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) = kfact_root(ji,jsl,ins) * 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=(mcfc-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
+    
+       ! Applay correction on the frozen fraction
+       ! Depends on two external parameters: froz_frac_corr and smtot_corr
+       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)
+    ! 
+    ! 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 
+
+    !! 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
+    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
+
+
+    !!! ADNV270716 *** we are here
+
+  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,nslm), INTENT (out)      :: shumdiag        !! relative soil moisture
+    REAL(r_std),DIMENSION (kjpindex,nslm), 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
+    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)
+    ! BUT THIS IS NOT USED ANYMORE WITH THE NEW BACKGROUNG ALBEDO
+    !! 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
+
+    soilmoist_liquid(:,:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          soilmoist_liquid(ji,1) = soilmoist_liquid(ji,1) + soiltile(ji,jst) * &
+               dz(2) * ( trois*mcl(ji,1,jst) + mcl(ji,2,jst) )/huit
+          DO jsl = 2,nslm-1
+             soilmoist_liquid(ji,jsl) = soilmoist_liquid(ji,jsl) + soiltile(ji,jst) * &
+                  ( dz(jsl) * (trois*mcl(ji,jsl,jst)+mcl(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mcl(ji,jsl,jst)+mcl(ji,jsl+1,jst))/huit )
+          END DO
+          soilmoist_liquid(ji,nslm) = soilmoist_liquid(ji,nslm) + soiltile(ji,jst) * &
+               dz(nslm) * (trois*mcl(ji,nslm,jst) + mcl(ji,nslm-1,jst))/huit
+       ENDDO
+    ENDDO
+    DO ji=1,kjpindex
+        soilmoist_liquid(ji,:) = soilmoist_liquid(ji,:) * vegtot_old(ji) ! grid cell average 
+    ENDDO
+    
+    
+    ! Shumdiag: we start from soil_wet_ns, change the range over which the relative moisture is calculated,
+    ! then do a spatial average, excluding the nobio fraction on which stomate doesn't act
+    DO jst=1,nstm      
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             shumdiag(ji,jsl) = shumdiag(ji,jsl) + soil_wet_ns(ji,jsl,jst) * soiltile(ji,jst) * &
+                               ((mcs(njsc(ji))-mcw(njsc(ji)))/(mcfc(njsc(ji))-mcw(njsc(ji))))
+             shumdiag(ji,jsl) = MAX(MIN(shumdiag(ji,jsl), 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 jsl=1,nslm              
+       DO ji=1,kjpindex
+          shumdiag_perma(ji,jsl) = soilmoist(ji,jsl) / (dh(jsl)*mcs(njsc(ji)))
+          shumdiag_perma(ji,jsl) = MAX(MIN(shumdiag_perma(ji,jsl), 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,nslm), 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, jsl, ji
+    REAL(r_std) :: snow_h
+    REAL(r_std)  :: lev_diag, prev_diag, lev_prog, prev_prog
+    REAL(r_std), DIMENSION(nslm,nslm) :: 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 jsl = 1, nslm
+             lev_prog = diaglev(jsl)
+             IF ((lev_diag.GT.diaglev(nslm).AND. &
+                  & prev_diag.LT.diaglev(nslm)-min_sechiba)) THEN
+                lev_diag=diaglev(nslm)          
+             ENDIF
+             intfactt(jh,jsl) = 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(nslm).AND. &
+               & prev_diag.GE.diaglev(nslm)-min_sechiba) intfactt(jh,nslm)=1.
+          prev_diag = lev_diag
+       ENDDO
+    ENDDO
+    
+    temp_hydro(:,:)=0.
+    DO jsl= 1, nslm
+       DO jh= 1, nslm
+          DO ji = 1, kjpindex
+             temp_hydro(ji,jh) = temp_hydro(ji,jh) + stempdiag(ji,jsl)*intfactt(jh,jsl)
+          ENDDO
+       ENDDO
+    ENDDO
+    
+  END SUBROUTINE hydrol_calculate_temp_hydro
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_nudge_mc_read
+!!
+!>\BRIEF         Read soil moisture from file and interpolate to the current time step
+!!
+!! DESCRIPTION  : Nudging of soil moisture and/or snow variables is done if OK_NUDGE_MC=y and/or OK_NUDGE_SNOW=y in run.def. 
+!!                This subroutine reads and interpolates spatialy if necessary and temporary the soil moisture from file. 
+!!                The values for the soil moisture will be applaied later using hydrol_nudge_mc
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_nudge_mc_read(kjit)
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit        !! Timestep number
+
+    !! 0.3 Locals variables
+    REAL(r_std)                                :: tau                   !! Position between to values in nudge mc file
+    REAL(r_std), DIMENSION(iim_g,jjm_g,nslm,1) :: mc_read_glo2D_1       !! mc from file at global 2D(lat,lon) grid per soiltile
+    REAL(r_std), DIMENSION(iim_g,jjm_g,nslm,1) :: mc_read_glo2D_2       !! mc from file at global 2D(lat,lon) grid per soiltile
+    REAL(r_std), DIMENSION(iim_g,jjm_g,nslm,1) :: mc_read_glo2D_3       !! mc from file at global 2D(lat,lon) grid per soiltile
+    REAL(r_std), DIMENSION(nbp_glo,nslm,nstm)  :: mc_read_glo1D         !! mc_read_glo2D on land-only vector form, in global
+    INTEGER(i_std), SAVE                       :: istart_mc !! start index to read from input file
+    INTEGER(i_std)                             :: iend                  !! end index to read from input file
+    INTEGER(i_std)                             :: i, j, ji, jg, jst, jsl!! loop index
+    INTEGER(i_std)                             :: iim_file, jjm_file, llm_file !! Dimensions in input file
+    INTEGER(i_std), SAVE                       :: ttm_mc      !! Time dimensions in input file
+    INTEGER(i_std), SAVE                       :: mc_id        !! index for netcdf files
+    LOGICAL, SAVE                              :: firsttime_mc=.TRUE.
+
+ 
+    !! 1. Nudging of soil moisture
+
+       !! 1.2 Read mc from file, once a day only
+       !!     The forcing file must contain daily frequency variable for the full year of the simulation
+       IF (MOD(kjit,INT(one_day/dt_sechiba)) == 1) THEN 
+          ! Save mc read from file from previous day
+          mc_read_prev = mc_read_next
+
+          IF (nudge_interpol_with_xios) THEN
+             ! Read mc from input file. XIOS interpolates it to the model grid before it is received here.
+             CALL xios_orchidee_recv_field("moistc_interp", mc_read_next)
+
+             ! Read and interpolation the mask for variable mc from input file. 
+             ! This is only done to be able to output the mask it later for validation purpose.
+             ! The mask corresponds to the fraction of the input source file which was underlaying the model grid cell. 
+             ! If the msask is 0 for a model grid cell, then the default value 0.2 set in field_def_orchidee.xml, is used for that grid cell. 
+             CALL xios_orchidee_recv_field("mask_moistc_interp", mask_mc_interp)
+
+          ELSE
+
+             ! Only read fields from the file. We here suppose that no interpolation is needed.
+             IF (is_root_prc) THEN 
+                IF (firsttime_mc) THEN
+                   ! Open and read dimenions in file
+                   CALL flininfo('nudge_moistc.nc',  iim_file, jjm_file, llm_file, ttm_mc, mc_id)
+                   
+                   ! Coherence test between dimension in the file and in the model run
+                   IF ((iim_file /= iim_g) .OR. (jjm_file /= jjm_g)) THEN
+                      WRITE(numout,*) 'hydrol_nudge: iim_file, jjm_file, llm_file, ttm_mc=', &
+                           iim_file, jjm_file, llm_file, ttm_mc
+                      WRITE(numout,*) 'hydrol_nudge: iim_g, jjm_g=', iim_g, jjm_g
+                      CALL ipslerr_p(2,'hydrol_nudge','Problem in coherence between dimensions in nudge_moistc.nc file and model',&
+                           'iim_file should be equal to iim_g','jjm_file should be equal to jjm_g')
+                   END IF
+                   
+                   firsttime_mc=.FALSE.
+                   istart_mc=julian_diff-1 ! initialize time counter to read
+                   IF (printlev>=2) WRITE(numout,*) "Start read nudge_moistc.nc file at time step: ", istart_mc+1
+                END IF
+
+                istart_mc=istart_mc+1  ! read next time step in the file
+                iend=istart_mc         ! only read 1 time step
+                
+                ! Read mc from file, one variable per soiltile
+                IF (printlev>=3) WRITE(numout,*) &
+                     "Read variables moistc_1, moistc_2 and moistc_3 from nudge_moistc.nc at time step: ", istart_mc
+                CALL flinget (mc_id, 'moistc_1', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_1)
+                CALL flinget (mc_id, 'moistc_2', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_2)
+                CALL flinget (mc_id, 'moistc_3', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_3)
+
+                ! Transform from global 2D(iim_g, jjm_g) into into land-only global 1D(nbp_glo)
+                ! Put the variables on the 3 soiltiles in the same file
+                DO ji = 1, nbp_glo
+                   j = ((index_g(ji)-1)/iim_g) + 1
+                   i = (index_g(ji) - (j-1)*iim_g)
+                   mc_read_glo1D(ji,:,1) = mc_read_glo2D_1(i,j,:,1)
+                   mc_read_glo1D(ji,:,2) = mc_read_glo2D_2(i,j,:,1)
+                   mc_read_glo1D(ji,:,3) = mc_read_glo2D_3(i,j,:,1)
+                END DO
+             END IF
+
+             ! Distribute the fields on all processors
+             CALL scatter(mc_read_glo1D, mc_read_next)
+
+             ! No interpolation is done, set the mask to 1
+             mask_mc_interp(:,:,:) = 1
+
+          END IF ! nudge_interpol_with_xios
+       END IF ! MOD(kjit,INT(one_day/dt_sechiba)) == 1
+       
+      
+       !! 1.3 Linear time interpolation between daily fields to the current time step
+       tau   = (kjit-1)*dt_sechiba/one_day - AINT((kjit-1)*dt_sechiba/one_day)
+       mc_read_current(:,:,:) = (1.-tau)*mc_read_prev(:,:,:) + tau*mc_read_next(:,:,:)
+
+       !! 1.4 Output daily fields and time interpolated fields only for debugging and validation purpose
+       CALL xios_orchidee_send_field("mc_read_next", mc_read_next)
+       CALL xios_orchidee_send_field("mc_read_current", mc_read_current)
+       CALL xios_orchidee_send_field("mc_read_prev", mc_read_prev)
+       CALL xios_orchidee_send_field("mask_mc_interp_out", mask_mc_interp)
+
+
+  END SUBROUTINE hydrol_nudge_mc_read
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_nudge_mc
+!!
+!>\BRIEF         Applay nuding for soil moisture
+!!
+!! DESCRIPTION  : Applay nudging for soil moisture. The nuding values were previously read and interpolated using 
+!!                the subroutine hydrol_nudge_mc_read
+!!                This subroutine is called from a loop over all soil tiles.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE hydrol_nudge_mc(kjpindex, jst, mc_loc)
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjpindex    !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: jst         !! Index for current soil tile
+       
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(kjpindex,nslm,nstm), INTENT(inout) :: mc_loc      !! Soil moisture
+    
+    !! 0.2 Locals variables
+    REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_aux                !! Temorary variable for calculation of nudgincsm
+    INTEGER(i_std)                             :: ji, jsl               !! loop index    
+    
+    
+    !! 1.5 Applay nudging of soil moisture using alpha_nudge_mc at each model sechiba time step.
+    !!     alpha_mc_nudge calculated using the parameter for relaxation time NUDGE_TAU_MC set in module constantes.
+    !!     alpha_nudge_mc is between 0-1
+    !!     If alpha_nudge_mc=1, the new mc will be replaced by the one read from file 
+    mc_loc(:,:,jst) = (1-alpha_nudge_mc)*mc_loc(:,:,jst) + alpha_nudge_mc * mc_read_current(:,:,jst)
+    
+    
+    !! 1.6 Calculate diagnostic for nudging increment of water in soil moisture
+    !!     Here calculate tmc_aux for the current soil tile. Later in hydrol_nudge_mc_diag, this will be used to calculate nudgincsm
+    mc_aux(:,:,jst)  = alpha_nudge_mc * ( mc_read_current(:,:,jst) - mc_loc(:,:,jst))
+    DO ji=1,kjpindex
+       tmc_aux(ji,jst) = dz(2) * ( trois*mc_aux(ji,1,jst) + mc_aux(ji,2,jst) )/huit
+       DO jsl = 2,nslm-1
+          tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(jsl) *  (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl-1,jst))/huit &
+               + dz(jsl+1) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl+1,jst))/huit
+       ENDDO
+       tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(nslm) * (trois*mc_aux(ji,nslm,jst) + mc_aux(ji,nslm-1,jst))/huit
+    ENDDO
+       
+
+  END SUBROUTINE hydrol_nudge_mc
+
+
+  SUBROUTINE hydrol_nudge_mc_diag(kjpindex, soiltile)
+    !! 0.1 Input variables    
+    INTEGER(i_std), INTENT(in)                         :: kjpindex    !! Domain size
+    REAL(r_std), DIMENSION(kjpindex,nstm), INTENT (in) :: soiltile    !! Fraction of each soil tile within vegtot (0-1, unitless)
+
+    !! 0.2 Locals variables
+    REAL(r_std), DIMENSION(kjpindex)           :: nudgincsm             !! Nudging increment of water in soil moisture
+    INTEGER(i_std)                             :: ji, jst               !! loop index
+
+
+    ! Average over grid-cell
+    nudgincsm(:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          nudgincsm(ji) = nudgincsm(ji) + vegtot(ji) * soiltile(ji,jst) * tmc_aux(ji,jst)
+       ENDDO
+    ENDDO
+    
+    CALL xios_orchidee_send_field("nudgincsm", nudgincsm)
+
+  END SUBROUTINE hydrol_nudge_mc_diag
+
+
+  !! ================================================================================================================================
+  !! SUBROUTINE   : hydrol_nudge_snow
+  !!
+  !>\BRIEF         Read, interpolate and applay nudging snow variables
+  !!
+  !! DESCRIPTION  : Nudging of snow variables is done if OK_NUDGE_SNOW=y is set in run.def
+  !!
+  !! RECENT CHANGE(S) : None
+  !!
+  !! MAIN IN-OUTPUT VARIABLE(S) : snowdz, snowrho, snowtemp
+  !!
+  !! REFERENCE(S) : 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+
+
+  SUBROUTINE hydrol_nudge_snow(kjit,   kjpindex, snowdz, snowrho, snowtemp )
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit        !! Timestep number
+    INTEGER(i_std), INTENT(in)                         :: kjpindex    !! Domain size
+
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout)     :: snowdz      !! Snow layer thickness
+    REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout)     :: snowrho     !! Snow density
+    REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout)     :: snowtemp    !! Snow temperature
+
+
+
+    !! 0.3 Locals variables
+    REAL(r_std)                                :: tau                   !! Position between to values in nudge mc file
+    REAL(r_std), DIMENSION(kjpindex,nsnow)     :: snowdz_read_current   !! snowdz from file interpolated to current timestep
+    REAL(r_std), DIMENSION(kjpindex,nsnow)     :: snowrho_read_current  !! snowrho from file interpolated to current timestep
+    REAL(r_std), DIMENSION(kjpindex,nsnow)     :: snowtemp_read_current !! snowtemp from file interpolated to current timestep
+    REAL(r_std), DIMENSION(kjpindex)           :: nudgincswe            !! Nudging increment of water in snow
+    REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowdz_read_glo2D     !! snowdz from file at global 2D(lat,lon) grid
+    REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowrho_read_glo2D    !! snowrho from file at global 2D(lat,lon) grid
+    REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowtemp_read_glo2D   !! snowrho from file at global 2D(lat,lon) grid
+    REAL(r_std), DIMENSION(nbp_glo,nsnow)      :: snowdz_read_glo1D     !! snowdz_read_glo2D on land-only vector form, in global
+    REAL(r_std), DIMENSION(nbp_glo,nsnow)      :: snowrho_read_glo1D    !! snowdz_read_glo2D on land-only vector form, in global
+    REAL(r_std), DIMENSION(nbp_glo,nsnow)      :: snowtemp_read_glo1D   !! snowdz_read_glo2D on land-only vector form, in global
+    INTEGER(i_std), SAVE                       ::  istart_snow!! start index to read from input file
+    INTEGER(i_std)                             :: iend                  !! end index to read from input file
+    INTEGER(i_std)                             :: i, j, ji, jg, jst, jsl!! loop index
+    INTEGER(i_std)                             :: iim_file, jjm_file, llm_file !! Dimensions in input file
+    INTEGER(i_std), SAVE                       :: ttm_snow      !! Time dimensions in input file
+    INTEGER(i_std), SAVE                       :: snow_id        !! index for netcdf files
+    LOGICAL, SAVE                              :: firsttime_snow=.TRUE.
+
+ 
+    !! 2. Nudging of snow variables
+    IF (ok_nudge_snow) THEN
+
+       !! 2.1 Read snow variables from file, once a day only
+       !!     The forcing file must contain daily frequency values for the full year of the simulation
+       IF (MOD(kjit,INT(one_day/dt_sechiba)) == 1) THEN 
+          ! Save variables from previous day
+          snowdz_read_prev   = snowdz_read_next
+          snowrho_read_prev  = snowrho_read_next
+          snowtemp_read_prev = snowtemp_read_next
+          
+          IF (nudge_interpol_with_xios) THEN
+             ! Read and interpolation snow variables and the mask from input file
+             CALL xios_orchidee_recv_field("snowdz_interp", snowdz_read_next)
+             CALL xios_orchidee_recv_field("snowrho_interp", snowrho_read_next)
+             CALL xios_orchidee_recv_field("snowtemp_interp", snowtemp_read_next)
+             CALL xios_orchidee_recv_field("mask_snow_interp", mask_snow_interp)
+
+          ELSE
+             ! Only read fields from the file. We here suppose that no interpolation is needed.
+             IF (is_root_prc) THEN 
+                IF (firsttime_snow) THEN
+                   ! Open and read dimenions in file
+                   CALL flininfo('nudge_snow.nc',  iim_file, jjm_file, llm_file, ttm_snow, snow_id)
+                   
+                   ! Coherence test between dimension in the file and in the model run
+                   IF ((iim_file /= iim_g) .OR. (jjm_file /= jjm_g)) THEN
+                      WRITE(numout,*) 'hydrol_nudge: iim_file, jjm_file, llm_file, ttm_snow=', &
+                           iim_file, jjm_file, llm_file, ttm_snow
+                      WRITE(numout,*) 'hydrol_nudge: iim_g, jjm_g=', iim_g, jjm_g
+                      CALL ipslerr_p(3,'hydrol_nudge','Problem in coherence between dimensions in nudge_snow.nc file and model',&
+                           'iim_file should be equal to iim_g','jjm_file should be equal to jjm_g')
+                   END IF
+                                         
+                   firsttime_snow=.FALSE.
+                   istart_snow=julian_diff-1  ! initialize time counter to read
+                   IF (printlev>=2) WRITE(numout,*) "Start read nudge_snow.nc file at time step: ", istart_snow+1
+                END IF
+
+                istart_snow=istart_snow+1  ! read next time step in the file
+                iend=istart_snow      ! only read 1 time step
+                
+                ! Read snowdz, snowrho and snowtemp from file
+                IF (printlev>=2) WRITE(numout,*) &
+                  "Read variables snowdz, snowrho and snowtemp from nudge_snow.nc at time step: ", istart_snow,ttm_snow
+                CALL flinget (snow_id, 'snowdz', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowdz_read_glo2D)
+                CALL flinget (snow_id, 'snowrho', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowrho_read_glo2D)
+                CALL flinget (snow_id, 'snowtemp', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowtemp_read_glo2D)
+
+
+                ! Transform from global 2D(iim_g, jjm_g) variables into into land-only global 1D variables (nbp_glo)
+                DO ji = 1, nbp_glo
+                   j = ((index_g(ji)-1)/iim_g) + 1
+                   i = (index_g(ji) - (j-1)*iim_g)
+                   snowdz_read_glo1D(ji,:) = snowdz_read_glo2D(i,j,:,1)
+                   snowrho_read_glo1D(ji,:) = snowrho_read_glo2D(i,j,:,1)
+                   snowtemp_read_glo1D(ji,:) = snowtemp_read_glo2D(i,j,:,1)
+                END DO
+             END IF
+
+             ! Distribute the fields on all processors
+             CALL scatter(snowdz_read_glo1D, snowdz_read_next)
+             CALL scatter(snowrho_read_glo1D, snowrho_read_next)
+             CALL scatter(snowtemp_read_glo1D, snowtemp_read_next)
+
+             ! No interpolation is done, set the mask to 1
+             mask_snow_interp=1
+
+          END IF ! nudge_interpol_with_xios
+
+          
+          ! Test if the values for depth of snow is in a valid range when read from the file, 
+          ! else set as no snow cover
+          DO ji=1,kjpindex
+             IF ((SUM(snowdz_read_next(ji,:)) .LE. 0.0) .OR. (SUM(snowdz_read_next(ji,:)) .GT. 100)) THEN
+                ! Snowdz has no valide values in the file, set here as no snow
+                snowdz_read_next(ji,:)   = 0
+                snowrho_read_next(ji,:)  = 50.0
+                snowtemp_read_next(ji,:) = tp_00
+             END IF
+          END DO
+
+       END IF ! MOD(kjit,INT(one_day/dt_sechiba)) == 1
+       
+      
+       !! 2.2 Linear time interpolation between daily fields for current time step
+       tau   = (kjit-1)*dt_sechiba/one_day - AINT((kjit-1)*dt_sechiba/one_day)
+       snowdz_read_current(:,:) = (1.-tau)*snowdz_read_prev(:,:) + tau*snowdz_read_next(:,:)
+       snowrho_read_current(:,:) = (1.-tau)*snowrho_read_prev(:,:) + tau*snowrho_read_next(:,:)
+       snowtemp_read_current(:,:) = (1.-tau)*snowtemp_read_prev(:,:) + tau*snowtemp_read_next(:,:)
+
+       !! 2.3 Output daily fields and time interpolated fields only for debugging and validation purpose
+       CALL xios_orchidee_send_field("snowdz_read_next", snowdz_read_next)
+       CALL xios_orchidee_send_field("snowdz_read_current", snowdz_read_current)
+       CALL xios_orchidee_send_field("snowdz_read_prev", snowdz_read_prev)
+       CALL xios_orchidee_send_field("snowrho_read_next", snowrho_read_next)
+       CALL xios_orchidee_send_field("snowrho_read_current", snowrho_read_current)
+       CALL xios_orchidee_send_field("snowrho_read_prev", snowrho_read_prev)
+       CALL xios_orchidee_send_field("snowtemp_read_next", snowtemp_read_next)
+       CALL xios_orchidee_send_field("snowtemp_read_current", snowtemp_read_current)
+       CALL xios_orchidee_send_field("snowtemp_read_prev", snowtemp_read_prev)
+       CALL xios_orchidee_send_field("mask_snow_interp_out", mask_snow_interp)
+
+       !! 2.4 Applay nudging of snow variables using alpha_nudge_snow at each model sechiba time step.
+       !!     alpha_snow_nudge calculated using the parameter for relaxation time NUDGE_TAU_SNOW set in module constantes.
+       !!     alpha_nudge_snow is between 0-1
+       !!     If alpha_nudge_snow=1, the new snow variables will be replaced by the ones read from file.
+       snowdz(:,:) = (1-alpha_nudge_snow)*snowdz(:,:) + alpha_nudge_snow * snowdz_read_current(:,:)
+       snowrho(:,:) = (1-alpha_nudge_snow)*snowrho(:,:) + alpha_nudge_snow * snowrho_read_current(:,:)
+       snowtemp(:,:) = (1-alpha_nudge_snow)*snowtemp(:,:) + alpha_nudge_snow * snowtemp_read_current(:,:)
+
+       !! 2.5 Calculate diagnostic for the nudging increment of water in snow
+       nudgincswe=0.
+       DO jg = 1, nsnow 
+          nudgincswe(:) = nudgincswe(:) +  &
+               alpha_nudge_snow*(snowdz_read_current(:,jg)*snowrho_read_current(:,jg)-snowdz(:,jg)*snowrho(:,jg))
+       END DO
+       CALL xios_orchidee_send_field("nudgincswe", nudgincswe)
+       
+    END IF
+
+  END SUBROUTINE hydrol_nudge_snow
+
+END MODULE hydrol
Index: /branches/publications/ORCHIDEE-AFP/src_sechiba/intersurf.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/intersurf.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/intersurf.f90	(revision 8430)
@@ -0,0 +1,1630 @@
+! ================================================================================================================================
+!  MODULE       : intersurf
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_year, one_day, dt_sechiba, time_initialize, time_nextstep, julian_diff
+  USE time, ONLY : year_end, month_end, day_end, sec_end
+  USE ioipslctrl, ONLY : ioipslctrl_history, ioipslctrl_restini, ioipslctrl_restclo, ok_histsync, max_hist_level, dw
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: Init_intersurf, intersurf_main, intersurf_main_2d, intersurf_main_gathered
+  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, 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                               :: nbcf_from_LMDZ    !! Number of optional coupled fields(fields_out) received from LMDZ, for ESM configuration 
+!$OMP THREADPRIVATE(nbcf_from_LMDZ)
+  INTEGER(i_std), SAVE                               :: nbcf_into_LMDZ    !! Number of optional coupled fields(fields_in) sent to LMDZ, for ESM configuration 
+!$OMP THREADPRIVATE(nbcf_into_LMDZ)
+  CHARACTER(LEN=30), ALLOCATABLE, DIMENSION(:), SAVE  :: field_out_names_loc !! Names of optional fields(fields_out) received from LMDZ, for ESM configuration 
+!$OMP THREADPRIVATE(field_out_names_loc)
+  CHARACTER(LEN=30), ALLOCATABLE, DIMENSION(:), SAVE  :: field_in_names_loc  !! Number of optional fields(fields_in) sent to LMDZ, for ESM configuration 
+!$OMP THREADPRIVATE(field_in_names_loc)
+
+  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)
+
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT (in)                            :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim, jjm        !! Dimension of input fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                 :: lrestart_read    !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                 :: lrestart_write   !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0           !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: u             !! Lowest level wind speed
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: v             !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_rain   !! Rain precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_snow   !! Snow precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lwdown        !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swdown        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: temp_air      !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: ccanopy       !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petAcoef      !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqAcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petBcoef      !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqBcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: pb            !! Surface pressure
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lon, lat      !! Geographical coordinates
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zcontfrac     !! Fraction of continent in the grid
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in)           :: zresolution   !! resolution in x and y dimensions
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: 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
+    INTEGER                                              :: old_fileout   !! old Logical Int for std IO output
+
+
+    IF (printlev >= 2) WRITE(numout,*) 'Start intersurf_initialize_2d'
+    CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
+
+    ! Initialize variables in module time
+    CALL time_initialize(kjit, date0, xrdt, "END")
+
+    !  Configuration of SSL specific parameters
+    CALL control_initialize
+
+    ! Initialize specific write level
+    printlev_loc=get_printlev('instersurf')
+    
+    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 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_end,  month_end,     day_end,  julian_diff, &
+         lon,     lat,       znt )
+
+    CALL sechiba_xios_initialize
+   
+    CALL xios_orchidee_close_definition
+    IF (printlev >= 2) WRITE(numout,*) 'After xios_orchidee_close_definition'
+
+    !- 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)
+ 
+    !
+    !  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)
+
+    !
+    ! 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
+
+    !
+    ! 2. 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,*) 'Before call to sechiba_initialize'
+    
+    CALL sechiba_initialize( &
+         itau_sechiba, iim*jjm,      kjpindex,      kindex,                     &
+         lalo,         contfrac,     neighbours,    resolution,  zzlev,         &
+         zu,           zv,           zqair,         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)
+    
+    IF (printlev_loc >= 3) WRITE(numout,*) 'After call to 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.
+    CALL ipslnlf_p(new_number=old_fileout)
+    IF (printlev_loc >= 1) WRITE (numout,*) 'End intersurf_initialize_2d'
+
+  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,nvm)                  :: zveget        !! Work array to keep veget
+    REAL(r_std),DIMENSION (kjpindex,nvm)                  :: zlai          !! Work array to keep lai
+    REAL(r_std),DIMENSION (kjpindex,nvm)                  :: zheight       !! Work array to keep height
+    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
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+
+    IF (printlev_loc >= 3) WRITE(numout,*) 'Start intersurf_main_2d'
+    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)
+
+    ! Update the calendar and all time variables in module time
+    CALL time_nextstep(itau_sechiba)
+    !
+    ! 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
+
+    !
+    ! 3. call sechiba for continental points only
+    !
+    IF (printlev_loc >= 3) WRITE(numout,*) 'Before call to sechiba_main from intersurf_main_2d'
+
+    CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, &
+         lrestart_read, lrestart_write, &
+         lalo, contfrac, neighbours, resolution, &
+         zzlev, zu, zv, zqair, 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,&
+         zveget, zlai, zheight, &
+         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC ) 
+    
+    IF (printlev_loc >= 3) WRITE(numout,*) 'After call to 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("temp_air",ztemp_air)
+    CALL xios_orchidee_send_field("qair",zqair)
+    CALL xios_orchidee_send_field("swnet",zswnet)
+    CALL xios_orchidee_send_field("swdown",zswdown)
+    CALL xios_orchidee_send_field("pb",zpb)
+    
+    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 (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)
+    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
+    
+    CALL ipslnlf_p(new_number=old_fileout)
+    IF (printlev_loc >= 3) WRITE (numout,*) 'End intersurf_main_2d'
+
+  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, grid)
+
+    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(i_std), INTENT(in), OPTIONAL :: grid          !! grid type : regular_lonlat or unstructured (dynamico)
+
+    INTEGER,DIMENSION(kjpindex)  :: kindex_offset
+
+    IF (printlev >= 1) WRITE(*,*) 'Start ORCHIDEE'
+
+    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 (printlev >= 1) WRITE(numout,*) 'Start ORCHIDEE intitalization phase'
+    
+    IF (is_omp_root) THEN
+       IF (PRESENT(grid)) THEN
+          IF (grid==unstructured) THEN
+             CALL grid_allocate_glo(6)
+          ELSE
+             CALL grid_allocate_glo(4)
+          END IF
+       ELSE
+          CALL grid_allocate_glo(4)
+       END IF
+    ENDIF
+   
+    CALL barrier2_omp()
+    CALL init_ioipsl_para
+          
+    kindex_offset(:)=kindex(:)+offset
+    CALL gather(kindex_offset,index_g)
+    CALL bcast(index_g)  
+
+    IF (printlev_loc >= 2) THEN
+       WRITE(numout,*) "kjpindex = ",kjpindex
+       WRITE(numout,*) "offset for OMP = ",offset_omp
+       WRITE(numout,*) "Index num local for continental points = ",kindex
+       WRITE(numout,*) "Index num global for continental points = ",kindex_offset
+       IF (is_omp_root) THEN
+          WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
+       ENDIF
+       IF (is_root_prc) THEN
+          WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
+       ENDIF
+    END IF
+
+
+
+  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, nvm_out, &
+       field_out_names, field_in_names, &
+       grid, bounds_latlon, cell_area, ind_cell_glo)
+
+    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 (:,:), INTENT(in)                :: latlon         !! Geographical coordinates, this variable has different dimension when using grid unstructured
+    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     !! Longitudes on the global 2D grid including ocean
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)    :: lat_scat_g     !! Latitudes on the global 2D grid including ocean
+
+    !! 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, obsolete: this variable is not used any more, kept only for retrocomp with LMDZ
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: t2m            !! Surface air temperature, obsolete: this variable is not used any more, kept only for retrocomp with LMDZ
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL :: z0h            !! Surface roughness (heat)
+    INTEGER(i_std), INTENT(out), OPTIONAL                  :: nvm_out        !! Number of vegetation types, PFTs
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)    :: field_out_names!! Name of optional fields sent to LMDZ (fields_out), for ESM configuration 
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)    :: field_in_names !! Name of optional fields received from LMDZ (fields_in), for ESM configuration 
+    INTEGER(i_std)                  , INTENT(in), OPTIONAL :: grid           !! grid type : regular_lonlat or unstructured (dynamico)
+    REAL(r_std),DIMENSION (:,:,:)   , INTENT(in), OPTIONAL :: bounds_latlon  !! boundaries Geographical coordinates
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: cell_area      !! cell area
+    INTEGER(i_std),DIMENSION (:)    , INTENT(in), OPTIONAL :: ind_cell_glo   !! cell order (for XIOS)
+
+
+    !! 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
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep river out flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: ier
+    INTEGER(i_std)                                        :: itau_sechiba
+    INTEGER(i_std)                                        :: grid_loc      !! Local variable for grid type
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)              :: tmp_lon       !! Longitudes for local MPI process. Only available on master OMP.
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)              :: tmp_lat       !! Latitudes for local MPI process. Only available on master OMP.
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+    REAL,ALLOCATABLE,DIMENSION(:,:)                       :: lalo_mpi
+    REAL(r_std),DIMENSION (kjpindex)                      :: landpoints    !! Land point vector
+    REAL(r_std)                                           :: tau_outflow   !! Number of days for temoral filter on river- and coastalflow
+
+ 
+    ! Initialize specific write level
+    printlev_loc=get_printlev('instersurf')
+
+    IF (printlev_loc >= 1) WRITE(numout,*) 'Entering intersurf_initialize_gathered'
+    IF (printlev_loc >= 2) WRITE(numout,*) 'using printlev_loc for intersurf:', printlev_loc
+
+    OFF_LINE_MODE = .FALSE. 
+    CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
+
+    ! Initialize variables in module time
+    CALL time_initialize( kjit, date0, xrdt, "END" )
+
+    !  Configuration of SSL specific parameters
+    CALL control_initialize
+
+   
+    ! Check if variable grid is in the argument list
+    IF (PRESENT(grid)) THEN
+      grid_loc=grid
+    ELSE
+      grid_loc=regular_lonlat
+    END IF    
+    IF (printlev >= 2) WRITE(numout,*) 'intersurf_initialize_gathered: grid=', grid_loc
+
+    IF (grid_loc==unstructured) THEN
+      ! First check if all variables needed are present in the call from LMDZ
+      IF (.NOT. PRESENT(bounds_latlon)) CALL ipslerr_p(3,'intersurf_initialize_gathered', &
+        'Error in call intersurf_initialize_gathered from LMDZ','bounds_latlon was not present','')
+
+      IF (.NOT. PRESENT(cell_area)) CALL ipslerr_p(3,'intersurf_initialize_gathered', &
+        'Error in call intersurf_initialize_gathered from LMDZ','cell_area was not present','')
+
+      IF (.NOT. PRESENT(ind_cell_glo)) CALL ipslerr_p(3,'intersurf_initialize_gathered', &
+        'Error in call intersurf_initialize_gathered from LMDZ','ind_cell_glo was not present','')
+
+      ! Allocation of grid variables for unstructured grid
+      IF (printlev_loc >= 3) WRITE(numout,*) 'intersurf_initialize_gathered: call grid_init_unstructured for unstructured grid'
+      CALL grid_init_unstructured(kjpindex,             ij_omp_nb,            latlon(:,2),  latlon(:,1), &
+                                  bounds_latlon(:,:,2), bounds_latlon(:,:,1), cell_area,    ind_cell_glo)
+    ELSE
+      ! Allocation of grid variables for rectilinear lon_lat grid
+      IF (printlev_loc >= 3) WRITE(numout,*) 'intersurf_initialize_gathered: call grid_init for rectilinear lon_lat grid'
+      CALL grid_init ( kjpindex, 4, regular_lonlat, "2DGrid" )
+    ENDIF
+
+
+    !
+    !  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)
+    !
+    IF (grid_type==regular_lonlat) 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 (is_omp_root) THEN
+       ! Extract from global variables the longitudes and latitudes 
+       ! for the local MPI process using the indices for the latitude bands(jj_begin, jj_end).
+       tmp_lon(:,:)=lon_scat_g(:,jj_begin:jj_end)
+       tmp_lat(:,:)=lat_scat_g(:,jj_begin:jj_end)
+       
+       ! Save the global variables only on mpi root, to be used in other modules
+       IF (is_mpi_root) THEN
+          lon_g(:,:) = lon_scat_g(:,:)
+          lat_g(:,:) = lat_scat_g(:,:)
+       ENDIF
+    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
+       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_end, month_end,     day_end, julian_diff, &
+         tmp_lon,  tmp_lat,  znt )
+
+    IF (printlev >= 3) WRITE(numout,*) 'intersurf_initialize_gathered: After xios_orchidee_init'
+    CALL sechiba_xios_initialize
+    IF (printlev >= 3) WRITE(numout,*) 'intersurf_initialize_gathered: After sechiba_xios_initialize'
+
+    CALL xios_orchidee_close_definition
+    IF (printlev >= 2) WRITE(numout,*) 'intersurf_initialize_gathered: After xios_orchidee_close_definition'
+
+    !- 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)
+
+    !
+    !! 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)
+    
+    !
+    ! 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
+
+     
+    !
+    ! 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,*) 'Before call to sechiba_initialize'
+
+    CALL sechiba_initialize( &
+         itau_sechiba, iim_g*jj_nb,  kjpindex,      kindex,                     &
+         lalo,         contfrac,     neighbours,    resolution,  zlev,          &
+         u,            v,            qair,          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)
+    
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'After call to 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(:)
+
+
+    ! 
+    ! 7. Count optional fields for the coupling with LMDZ, used in the ESM configuration 
+    !
+    ! Treat fields sent to LMDZ
+    IF (PRESENT(field_out_names)) THEN
+       nbcf_from_LMDZ=SIZE(field_out_names)
+       ALLOCATE(field_out_names_loc(nbcf_from_LMDZ), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialized_gathered', 'Error in allocation of field_out_names_loc','','')
+       field_out_names_loc=field_out_names
+    ELSE
+       nbcf_from_LMDZ=0
+    ENDIF
+
+    ! Treat fields received from LMDZ
+    IF (PRESENT(field_in_names)) THEN
+       nbcf_into_LMDZ=SIZE(field_in_names)
+       ALLOCATE(field_in_names_loc(nbcf_into_LMDZ), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialized_gathered', 'Error in allocation of field_in_names_loc','','')
+       field_in_names_loc=field_in_names
+
+       ! Coherence test: veget_update>0 needed for fCO2_fLuc and fCO2_nbp
+       DO i = 1, nbcf_into_LMDZ
+          IF ((field_in_names_loc(i) == 'fCO2_fLuc') .OR. (field_in_names_loc(i) == 'fCO2_nbp')) THEN
+             IF (veget_update .LE. 0) THEN
+                CALL ipslerr_p(3,'intersurf_initialize_gathered', &
+                     'Error in set up. VEGET_UPDATE must be > 0 when using the field: '//TRIM(field_in_names_loc(i)),'','')
+             END IF
+          END IF
+       END DO
+    ELSE
+       nbcf_into_LMDZ=0
+    ENDIF
+    IF ( printlev_loc>=2 ) THEN
+       WRITE(numout,*) 'intersurf_initialized_gathered --- nbcf_from_LMDZ, nbcf_into_LMDZ = ',nbcf_from_LMDZ, nbcf_into_LMDZ
+       IF (nbcf_into_LMDZ > 0) THEN
+          WRITE(numout,*) 'intersurf_initialized_gathered --- field_in_names_loc = ', field_in_names_loc
+       END IF
+       IF (nbcf_from_LMDZ > 0) THEN
+          WRITE(numout,*) 'intersurf_initialized_gathered --- field_out_names_loc = ', field_out_names_loc
+       END IF
+    END IF
+
+    ! 
+    ! 8. Distribution of coastal- and riverflow on several time steps
+    !
+    !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 in allocation 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
+    
+    ! 
+    ! 9.
+    !
+    ! Copy the number of vegetation types to local output variable
+    IF (PRESENT(nvm_out)) nvm_out=nvm
+
+    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")
+
+    IF (printlev_loc >= 2) WRITE (numout,*) 'End intersurf_initialize_gathered'
+    IF (printlev_loc >= 1) WRITE (numout,*) 'Initialization phase for ORCHIDEE is finished.'
+
+  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, &
+       veget, lai, height, &
+       fields_out, fields_in,  &
+       coszang)
+
+    USE mod_orchidee_para
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT (in)                            :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim_glo         !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                            :: jjm_glo         !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                  :: lrestart_read   !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                  :: lrestart_write  !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0           !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: u               !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: v               !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: zlev            !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: qair            !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: precip_rain     !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: precip_snow     !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: lwdown          !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: swnet           !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: swdown          !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: temp_air        !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: epot_air        !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: ccanopy         !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: petAcoef        !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: peqAcoef        !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: petBcoef        !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: peqBcoef        !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: pb              !! Surface pressure
+    REAL(r_std),DIMENSION (:,:)     , INTENT(in)          :: latlon          !! Geographical coordinates
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: zcontfrac       !! Fraction of continent
+    INTEGER(i_std),DIMENSION (:,:), 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, time filtered (m^3/s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: riverflow_cpl   !! Largest rivers flowing into the ocean, time filtered (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, obsolete: this variable is not used any more, kept only for retrocomp with LMDZ
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: t2m             !! Surface air temperature, obsolete: this variable is not used any more, kept only for retrocomp with LMDZ
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL:: z0h             !! Surface roughness for heat
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: veget     !! Fraction of vegetation type (unitless, 0-1) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: lai       !! Leaf area index (m^2 m^{-2}
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: height    !! Vegetation Height (m)
+    REAL(r_std), DIMENSION(kjpindex), OPTIONAL, INTENT(in):: coszang         !! Cosine of the solar zenith angle (unitless)
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT)     :: fields_in       !! Optional fields sent to LMDZ, for ESM configuration 
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN)      :: fields_out      !! Optional fields received from LMDZ, for ESM configuration 
+
+
+    !! 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
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep river out flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoszang      !! Work array to keep coszang
+    REAL(r_std),DIMENSION (kjpindex,nvm)                  :: zveget        !! Work array to keep veget
+    REAL(r_std),DIMENSION (kjpindex,nvm)                  :: zlai          !! Work array to keep lai
+    REAL(r_std),DIMENSION (kjpindex,nvm)                  :: zheight       !! Work array to keep height
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: ier
+    INTEGER(i_std)                                        :: itau_sechiba
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+    REAL,ALLOCATABLE,DIMENSION(:,:)                       :: lalo_mpi
+    REAL(r_std),DIMENSION (kjpindex)                      :: landpoints    !! Local landpoints vector
+
+    IF (printlev_loc >= 3) WRITE(numout,*) 'Start intersurf_main_gathered'
+    CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
+    
+    IF (lstep_init_intersurf) THEN
+       ! intersurf_initialize_gathered was not yet called. An old version of
+       ! LMDZ is used. Now prepare and call intersurf_initialize_gathered
+
+       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, &
+            zz0h)
+
+       ! 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)
+    
+    ! Update the calendar and all time variables in module time
+    CALL time_nextstep(itau_sechiba)
+    
+    !
+    ! 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
+ 
+    ! Optional fields received from LMDZ, for ESM configuration
+    ! No fields are currently received from LMDZ
+    DO i = 1, nbcf_from_LMDZ 
+       SELECT CASE(TRIM(field_out_names_loc(i)))
+       ! CASE("...")
+          ! Things to do for this case...
+        CASE("atmco2")
+          IF (printlev_loc > 4) WRITE(numout,*) &
+               'Retreive the atmco2 field, in this case equal to fields_out(:,i)=ccanopy(:)'
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intersurf_main_gathered', &
+               'The selected field received from LMDZ '//TRIM(field_out_names_loc(i))//' is not implemented.','','')
+       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,*) 'Before call to sechiba_main from intersurf_main_gathered'
+   
+
+    CALL sechiba_main (itau_sechiba, iim_g*jj_nb, kjpindex, kindex, &
+         lrestart_read, lrestart_write, &
+         lalo, contfrac, neighbours, resolution, &
+         zlev, u, v, qair, 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, &
+         zveget, zlai, zheight, &
+         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC ) 
+
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'After call to sechiba_main'
+
+    !
+    ! 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
+
+    ! Copy variables only if the optional variables are present in the call to the subroutine
+    IF (PRESENT(veget))  veget(:,:)  = zveget(:,:) 
+    IF (PRESENT(lai))    lai(:,:)    = zlai(:,:) 
+    IF (PRESENT(height)) height(:,:) = zheight(:,:) 
+
+
+    !
+    ! 7. Set variables to be sent to LMDZ, for ESM configuration
+    !    field_in_names_loc should be consitent with the names used in coupling_fields.def read by LMDZ
+    !
+    IF (nbcf_into_LMDZ.GT.0) THEN
+       DO ik=1, kjpindex
+          DO i = 1, nbcf_into_LMDZ
+             SELECT CASE(TRIM(field_in_names_loc(i)))
+             CASE("fCO2_nep")
+                fields_in(ik,i) = znetco2(ik)
+             CASE("fCO2_fLuc")
+                fields_in(ik,i) = zcarblu(ik)
+             CASE("fCO2_nbp")
+                fields_in(ik,i) = znetco2(ik) + zcarblu(ik)
+             CASE DEFAULT
+                CALL ipslerr_p (3,'intersurf_main_gathered', &
+                     'The selected field to be sent to LMDZ '//TRIM(field_in_names_loc(i))//' is not yet implemented.','','')
+             END SELECT
+          END  DO
+       ENDDO
+    END IF
+    
+
+    ! 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("temp_air",temp_air)
+    CALL xios_orchidee_send_field("qair",qair)
+    CALL xios_orchidee_send_field("swnet",swnet)
+    CALL xios_orchidee_send_field("swdown",swdown)
+    CALL xios_orchidee_send_field("pb",pb)
+    CALL xios_orchidee_send_field("riverflow_cpl",riverflow_cpl)
+    CALL xios_orchidee_send_field("coastalflow_cpl",coastalflow_cpl)
+    
+    
+    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 ( 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)
+       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
+    
+  
+
+    ! 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 ioipslctrl_restclo
+       CALL xios_orchidee_context_finalize
+    END IF
+    !
+    !! Change back to be in the LMDZ context for XIOS
+    !
+    CALL xios_orchidee_change_context("LMDZ")
+
+    IF (printlev_loc >= 3) WRITE (numout,*) 'End intersurf_main_gathered'
+
+  END SUBROUTINE intersurf_main_gathered
+
+!! ================================================================================================================================
+!! 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-AFP/src_sechiba/ioipslctrl.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/ioipslctrl.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/ioipslctrl.f90	(revision 8430)
@@ -0,0 +1,3513 @@
+! ================================================================================================================================
+!  MODULE       : ioipslctrl
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_day, dt_sechiba
+  USE constantes_soil
+  USE pft_parameters
+  USE grid 
+  USE xios_orchidee, ONLY : xios_orchidee_ok 
+
+  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     !! 
+  
+  INTEGER,PARAMETER                :: max_nb_restfile_ids=100
+  INTEGER,SAVE                     :: restfile_ids(max_nb_restfile_ids)
+!$OMP THREADPRIVATE(restfile_ids)
+  INTEGER,SAVE                     :: nb_restfile_ids=0
+!$OMP THREADPRIVATE(nb_restfile_ids)
+  
+  PRIVATE
+  PUBLIC :: ioipslctrl_history, ioipslctrl_histstom, ioipslctrl_histstomipcc, ioipslctrl_restini, ioipslctrl_restclo
+  PUBLIC :: dw, max_hist_level, ok_histsync
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_history
+!!
+!>\BRIEF	 This subroutine initialize the IOIPSL output files
+!! 
+!! DESCRIPTION   : This subroutine initialize the IOIPSL output files sechiab_history.nc and sechiba_out_2.nc. It also calls the
+!!                 the subroutines ioipslctrl_histstom and ioipslctrl_histstomipcc for initialization of the IOIPSL stomate output files.
+!!                 This subroutine was previously called intsurf_history and located in module intersurf.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_history(iim, jjm, lon, lat, kindex, kjpindex, istp_old, date0, dt, hist_id, hist2_id, &
+       hist_id_stom, hist_id_stom_IPCC)
+    
+    USE mod_orchidee_para
+    !   
+    !  This subroutine initialized the history files for the land-surface scheme
+    !
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)                  :: iim, jjm  !! Size in x and y of the data to be handeled
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat  !! Longitude and latitude of the data points
+    INTEGER(i_std),INTENT (in)                            :: kjpindex
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex
+    
+    INTEGER(i_std), INTENT(in)                  :: istp_old  !! Time step counter
+    REAL(r_std), INTENT(in)                     :: date0     !! Julian day at which istp=0
+    REAL(r_std), INTENT(in)                     :: dt        !! Time step of the counter in seconds
+
+    INTEGER(i_std), INTENT(out)                 :: hist_id   !! History file identification for SECHIBA
+    INTEGER(i_std), INTENT(out)                 :: hist2_id  !! History file 2 identification for SECHIBA
+    !! History file identification for STOMATE and IPCC
+    INTEGER(i_std), INTENT(out)                 :: hist_id_stom, hist_id_stom_IPCC 
+    !
+    !  LOCAL
+    !
+    CHARACTER(LEN=80) :: histname,histname2                    !! Name of history files for SECHIBA
+    CHARACTER(LEN=80) :: stom_histname, stom_ipcc_histname     !! Name of history files for STOMATE
+    LOGICAL           :: ok_histfile2                 !! Flag to switch on histfile 2 for SECHIBA
+    REAL(r_std)       :: dw2                          !! frequency of history write (sec.)
+    CHARACTER(LEN=30)   :: flux_op                    !! Operations to be performed on fluxes
+    CHARACTER(LEN=40)   :: flux_insec, flux_scinsec   !! Operation in seconds
+    INTEGER(i_std)     :: hist_level, hist2_level     !! history output level (default is 10 => maximum output)
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
+         & ave, avecels, avescatter, fluxop, &
+         & fluxop_scinsec, tmincels, tmaxcels, once, sumscatter  !! The various operation to be performed
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
+         & ave2, avecels2, avescatter2, fluxop2, &
+         & fluxop_scinsec2, tmincels2, tmaxcels2, once2, sumscatter2  !! The various operation to be performed
+    CHARACTER(LEN=80) :: global_attribute              !! for writing attributes in the output files
+    INTEGER(i_std)     :: i, jst
+    ! SECHIBA AXIS
+    INTEGER(i_std)     :: hori_id                      !! ID of the default horizontal longitude and latitude map.
+    INTEGER(i_std)     :: vegax_id, laiax_id, solax_id, soltax_id, nobioax_id !! ID's for two vertical coordinates
+    INTEGER(i_std)     :: soildiagax_id                !! ID for diagnostic soil levels
+    INTEGER(i_std)     :: solayax_id                   !! ID for the vertical axis of the CWRR hydrology 
+    INTEGER(i_std)     :: hori_id2                      !! ID of the default horizontal longitude and latitude map.
+    INTEGER(i_std)     :: vegax_id2, laiax_id2, solax_id2, soltax_id2, nobioax_id2, albax_id2 !! ID's for two vertical coordinates
+    INTEGER(i_std)     :: solayax_id2                   !! ID for the vertical axis of the CWRR hydrology 
+    INTEGER(i_std)     :: snowax_id                     !! ID for snow level axis
+
+    ! STOMATE AXIS
+    INTEGER(i_std)     :: hist_PFTaxis_id
+! deforestation
+    INTEGER(i_std)     :: hist_pool_10axis_id
+    INTEGER(i_std)     :: hist_pool_100axis_id
+    INTEGER(i_std)     :: hist_pool_11axis_id
+    INTEGER(i_std)     :: hist_pool_101axis_id
+    ! STOMATE IPCC AXIS
+    INTEGER(i_std)     :: hist_IPCC_PFTaxis_id
+    !
+    INTEGER(i_std)                         :: ier
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_rect, lat_rect
+    !
+    REAL(r_std),DIMENSION(nvm)   :: veg
+    REAL(r_std),DIMENSION(nlai+1):: 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
+    !
+    ! IPCC history file
+    REAL(r_std)                  :: hist_days_stom_ipcc     !!- GK time step in days for this history file
+    REAL(r_std)                  :: hist_dt_stom_ipcc       !!- GK time step in seconds for this history file
+!
+    !
+    !=====================================================================
+    !- 3.0 Setting up the history files
+    !=====================================================================
+    !- 3.1 SECHIBA
+    !=====================================================================
+    !Config Key   = ALMA_OUTPUT
+    !Config Desc  = Should the output follow the ALMA convention
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = If this logical flag is set to true the model
+    !Config         will output all its data according to the ALMA 
+    !Config         convention. It is the recommended way to write
+    !Config         data out of ORCHIDEE.
+    !Config Units = [FLAG]
+    CALL getin_p('ALMA_OUTPUT', almaoutput)    
+    IF (printlev>=2) 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)
+    IF (printlev>=2) 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>=2) WRITE(numout,*) 'All IOIPSL output are deactivated because this run uses XIOS'
+    ELSE
+      CALL getin_p('WRITE_STEP', dw)
+      IF ( dw == 0 .AND. printlev>=1) WRITE(numout,*) 'sechiba_history file will not be created'
+    END IF
+    
+    veg(1:nvm)   = (/ (REAL(i,r_std),i=1,nvm) /)
+    indlai(1:nlai+1) = (/ (REAL(i,r_std),i=1,nlai+1) /)
+    soltyp(1:nstm) = (/ (REAL(i,r_std),i=1,nstm) /)
+    nobiotyp(1:nnobio) = (/ (REAL(i,r_std),i=1,nnobio) /)
+    albtyp(1:2) = (/ (REAL(i,r_std),i=1,2) /)
+    solay(1:nslm) = (/ (REAL(i,r_std),i=1,nslm) /)
+    snowlev =  (/ (REAL(i,r_std),i=1,nsnow) /)
+
+    !
+    !- 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
+    IF (printlev>=2) 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)
+    !-
+    IF (printlev>=2) WRITE(numout,*) 'SECHIBA history level: ',hist_level
+    IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
+       STOP 'This history level is not allowed'
+    ENDIF
+    !-
+    !- define operations as a function of history level.
+    !- Above hist_level, operation='never'
+    !-
+    ave(1:max_hist_level) = 'ave(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       ave(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    sumscatter(1:max_hist_level) = 't_sum(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       sumscatter(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    avecels(1:max_hist_level) = 'ave(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       avecels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    avescatter(1:max_hist_level) = 'ave(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       avescatter(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmincels(1:max_hist_level) = 't_min(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       tmincels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmaxcels(1:max_hist_level) = 't_max(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       tmaxcels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    fluxop(1:max_hist_level) = flux_op
+    IF (hist_level < max_hist_level) THEN
+       fluxop(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    fluxop_scinsec(1:max_hist_level) = flux_scinsec
+    IF (hist_level < max_hist_level) THEN
+       fluxop_scinsec(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    once(1:max_hist_level) = 'once(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       once(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+
+    !- Initialize sechiba_history output file
+    !- 
+    IF ( dw == 0 ) THEN
+       ! sechiba_history file will not be created.
+       hist_id = -1
+
+    ELSE
+       ! sechiba_history file will be created
+
+       ! 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. Therefor exit if this is the cas. 
+       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 ( grid_type == regular_lonlat ) 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 ( grid_type == regular_lonlat ) 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
+             IF (printlev >= 2) 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', 'm', &
+               &   nlai+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', &
+               &    nslm, diaglev(1:nslm), 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, '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, '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)
+          !-
+          !- 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)
+             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)
+          END IF
+          
+          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)
+          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, '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,nslm,1,nslm, 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_stomate ) THEN
+             CALL histdef(hist_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt, dw)
+          ENDIF
+          CALL histdef(hist_id, 'precisol', 'Throughfall', 'mm/d',  &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(4), dt,dw)
+          CALL histdef(hist_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'evapot', 'Potential evaporation', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
+          CALL histdef(hist_id, 'evapot_corr', 'Potential evaporation', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 5
+          !-
+          CALL histdef(hist_id, 'swnet', 'Net solar radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
+          CALL histdef(hist_id, 'swdown', 'Incident solar radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
+          CALL histdef(hist_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
+          CALL histdef(hist_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 6
+          !-
+          CALL histdef(hist_id, 'ptn', 'Deep ground temperature', 'K', &
+               & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(6),  dt,dw)
+          CALL histdef(hist_id, 'snowmelt', 'snow melt', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(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, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'gs', 'gs', 'mol m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'assimi', 'assimi', 'mol m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Rd', 'Rd', 'mol m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Cc', 'Cc', 'ppm', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'limitphoto', 'limitphoto', '-', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Vc', 'Vc', 'mol m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Vj', 'Vj', 'mol e- m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+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, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(11), dt,dw)
+                   CALL histdef(hist_id, 'PARshtab', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(11), dt,dw)
+                ENDIF
+                CALL histdef(hist_id, 'coszang', 'coszang', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARdf', 'PARdf', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARdr', 'PARdr', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Trans', 'Trans', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+             END IF
+             
+             CALL histdef(hist_id, 'flx_fertil_no', 'flx_fertil_no', 'ngN/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'CRF', 'CRF', '1', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_co2_bbg_year', 'flx_co2_bbg_year', 'kgC/m^2/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'N_qt_WRICE_year', 'N_qt_WRICE_year', 'kgN/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'N_qt_OTHER_year', 'N_qt_OTHER_year', 'kgN/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'flx_iso', 'flx_iso', 'kgC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_mono', 'flx_mono', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_apinen', 'flx_apinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_bpinen', 'flx_bpinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_limonen', 'flx_limonen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_myrcen', 'flx_myrcen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_sabinen', 'flx_sabinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_camphen', 'flx_camphen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_3caren', 'flx_3caren', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_tbocimen', 'flx_tbocimen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_othermono', 'flx_othermono', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_sesquiter', 'flx_sesquiter', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_ORVOC', 'flx_ORVOC', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_MBO', 'flx_MBO', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_methanol', 'flx_methanol', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetone', 'flx_acetone', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetal', 'flx_acetal', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_formal', 'flx_formal', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetic', 'flx_acetic', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_formic', 'flx_formic', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_no_soil', 'flx_no_soil', 'ngN/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_no', 'flx_no', 'ngN/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'fco2', 'fco2', '-', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          ENDIF
+
+       ELSE 
+          !-
+          !- This is the ALMA convention output now
+          !-
+          !- 
+          IF ( grid_type == regular_lonlat ) 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', &
+               &   nlai+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,nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'gs', 'gs', 'mol m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'assimi', 'assimi', 'mol m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Rd', 'Rd', 'mol m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Cc', 'Cc', 'ppm', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'limitphoto', 'limitphoto', '-', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Vc', 'Vc', 'mol m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'Vj', 'Vj', 'mol e- m-2 s-1', &
+               & iim,jjm, hori_id, nlai+1, 1, nlai+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)
+    IF (printlev >= 2) 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.
+       IF (printlev >= 2) 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.
+       IF (printlev >= 2) 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)
+       IF (printlev >= 2) 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)
+       !-
+       IF (printlev >= 2) 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 ( grid_type == regular_lonlat ) 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
+                IF (printlev >= 2) WRITE(numout,*)  'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+             ENDIF
+             !-
+             CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
+                  &    nvm,   veg, vegax_id2)
+             CALL histvert(hist2_id, 'laiax', 'Nb LAI', '1', &
+                  &    nlai+1,   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)
+             !-
+             !- 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, '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', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
+
+             !-
+             !- SECHIBA_HISTLEVEL2 = 7
+             !-
+             CALL histdef(hist2_id, 'swnet', 'Net solar radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
+             CALL histdef(hist2_id, 'swdown', 'Incident solar radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
+             CALL histdef(hist2_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 8
+             !-
+             IF ( 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', 'mol/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, nlai+1, 1, nlai+1, laiax_id2, 32, avescatter2(10), dt,dw2)
+                      CALL histdef(hist2_id, 'PARshtab', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                           & iim,jjm, hori_id2, nlai+1, 1, nlai+1, laiax_id2, 32, avescatter2(10), dt,dw2)
+                   ENDIF
+                   CALL histdef(hist2_id, 'coszang', 'coszang', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARdf', 'PARdf', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARdr', 'PARdr', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Trans', 'Trans', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                END IF
+                
+                CALL histdef(hist2_id, 'flx_fertil_no', 'flx_fertil_no', 'ngN/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'CRF', 'CRF', '1', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_co2_bbg_year', 'flx_co2_bbg_year', 'kgC/m^2/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'N_qt_WRICE_year', 'N_qt_WRICE_year', 'kgN/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'N_qt_OTHER_year', 'N_qt_OTHER_year', 'kgN/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'flx_iso', 'flx_iso', 'kgC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_mono', 'flx_mono', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_apinen', 'flx_apinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_bpinen', 'flx_bpinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_limonen', 'flx_limonen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_myrcen', 'flx_myrcen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_sabinen', 'flx_sabinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_camphen', 'flx_camphen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_3caren', 'flx_3caren', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_tbocimen', 'flx_tbocimen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_othermono', 'flx_othermono', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_sesquiter', 'flx_sesquiter', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_ORVOC', 'flx_ORVOC', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_MBO', 'flx_MBO', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_methanol', 'flx_methanol', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetone', 'flx_acetone', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(1), dt,dw2)   !! LDF TEST modificato a 1... !!
+                CALL histdef(hist2_id, 'flx_acetal', 'flx_acetal', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(1), dt,dw2)   !! LDF TEST modificato a 1... !!
+                CALL histdef(hist2_id, 'flx_formal', 'flx_formal', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetic', 'flx_acetic', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_formic', 'flx_formic', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_no_soil', 'flx_no_soil', 'ngN/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_no', 'flx_no', 'ngN/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+             ENDIF
+         ELSE 
+             !-
+             !- This is the ALMA convention output now
+             !-
+             !- 
+             IF ( grid_type == regular_lonlat ) 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
+                IF (printlev >= 2) 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)       
+       IF (printlev >= 2) 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
+          IF (printlev >= 2) 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
+          IF (printlev >= 2) 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
+          IF (printlev >= 2) WRITE(numout,*) 'STOMATE history file will not be created'
+       ELSE
+          hist_dt_stom = NINT( hist_days_stom ) * one_day
+          IF (printlev >= 2) 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
+             IF (printlev >= 2) 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 ( grid_type == regular_lonlat ) 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)
+       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)
+       
+       !- 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)       
+       IF (printlev >= 2) 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
+          IF (printlev >= 2) WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
+       ELSE
+          hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
+          IF (printlev >= 2) 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
+          IF (printlev >= 2) 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
+             IF (printlev >= 2) 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 ( grid_type == regular_lonlat ) 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)
+    ! deforestation axis added as arguments
+
+    !---------------------------------------------------------------------
+    !- Tell ioipsl which variables are to be written
+    !- and on which grid they are defined
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    !- Input
+    !-
+    !- File id
+    INTEGER(i_std),INTENT(in) :: hist_id_stom
+    !- number of PFTs
+    INTEGER(i_std),INTENT(in) :: nvm
+    !- Domain size
+    INTEGER(i_std),INTENT(in) :: iim, jjm
+    !- Time step of STOMATE (seconds)
+    REAL(r_std),INTENT(in)    :: dt
+    !- Time step of history file (s)
+    REAL(r_std),INTENT(in)    :: hist_dt
+    !- id horizontal grid
+    INTEGER(i_std),INTENT(in) :: hist_hori_id
+    !- id of PFT axis
+    INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
+    !- id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_10axis_id,hist_pool_100axis_id
+    INTEGER(i_std),INTENT(in) :: hist_pool_11axis_id,hist_pool_101axis_id
+    !-
+    !- 1 local
+    !-
+    !- maximum history level
+    INTEGER(i_std), PARAMETER  :: max_hist_level = 10
+    !- output level (between 0 and 10)
+    !-  ( 0:nothing is written, 10:everything is written)
+    INTEGER(i_std)             :: hist_level
+    !- Character strings to define operations for histdef
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
+
+    !---------------------------------------------------------------------
+    !=====================================================================
+    !- 1 history level
+    !=====================================================================
+    !- 1.1 define history levelx
+    !=====================================================================
+    !Config Key   = STOMATE_HISTLEVEL
+    !Config Desc  = STOMATE history output level (0..10)
+    !Config 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)
+    !-
+    IF (printlev >= 2) WRITE(numout,*) 'STOMATE history level: ',hist_level
+    IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
+       STOP 'This history level is not allowed'
+    ENDIF
+    !=====================================================================
+    !- 1.2 define operations according to output level
+    !=====================================================================
+    ave(1:hist_level) =  'ave(scatter(X))'
+    ave(hist_level+1:max_hist_level) =  'never          '
+    !=====================================================================
+    !- 2 surface fields (2d)
+    !- 3 PFT: 3rd dimension
+    !=====================================================================
+
+
+    ! structural litter above ground
+    IF (is_omp_root) THEN
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_STR_AB       "), &
+            &               TRIM("structural litter above ground                    "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! metabolic litter above ground                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_MET_AB       "), &
+            &               TRIM("metabolic litter above ground                     "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! structural litter below ground               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_STR_BE       "), &
+            &               TRIM("structural litter below ground                    "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! metabolic litter below ground                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_MET_BE       "), &
+            &               TRIM("metabolic litter below ground                     "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! fraction of soil covered by dead leaves           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("DEADLEAF_COVER      "), &
+            &               TRIM("fraction of soil covered by dead leaves           "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       
+       ! total soil and litter carbon
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_SOIL_CARB     "), &
+            &               TRIM("total soil and litter carbon                      "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! active soil carbon in ground                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_ACTIVE       "), &
+            &               TRIM("active soil carbon in ground                      "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! slow soil carbon in ground                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_SLOW         "), &
+            &               TRIM("slow soil carbon in ground                        "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! passive soil carbon in ground                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_PASSIVE      "), &
+            &               TRIM("passive soil carbon in ground                     "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! Long term 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_LONGTERM        "), &
+            &               TRIM("Longterm 2 m temperature                          "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(9), dt, hist_dt)
+       
+       ! Monthly 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_MONTH           "), &
+            &               TRIM("Monthly 2 m temperature                           "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+       ! Weekly 2 m temperature                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_WEEK            "), &
+            &               TRIM("Weekly 2 m temperature                            "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+       ! heterotr. resp. from ground                  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HET_RESP            "), &
+            &               TRIM("heterotr. resp. from ground                       "), &
+            &               TRIM("gC/m^2 tot/pft/day  "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+       
+       ! Fire fraction on ground
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREFRAC            "), &
+            &               TRIM("Fire fraction on ground                           "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Fire index on ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREINDEX           "), &
+            &               TRIM("Fire index on ground                              "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+       
+       ! Litter humidity                                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTERHUM           "), &
+            &               TRIM("Litter humidity                                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       
+       ! CO2 flux                                  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2FLUX             "), &
+            &               TRIM("CO2 flux                                          "), &
+            &               TRIM("gC/m^2/pft/mth      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Output CO2 flux from fire                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2_FIRE            "), &
+            &               TRIM("Output CO2 flux from fire                         "), &
+            &               TRIM("gC/day/m^2/pft      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! CO2 taken from atmosphere for initiate growth     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2_TAKEN           "), &
+            &               TRIM("CO2 taken from atmosphere for initiate growth     "), &
+            &               TRIM("gC/day/m^2/pft      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       IF (ok_dgvm) THEN
+          ! total co2 flux (sum over 13 PFTs). when DGVM is activated, the previous
+          ! SUM(CO2FLUX*veget_max) is wrong. We should look at this variable.
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2FLUX            "), &
+               &               TRIM("total CO2flux of 13 PFTs (after adjustment)       "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          ! should be the same with tCO2FLUX
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2FLUX_OLD        "), &
+               &               TRIM("total CO2flux of 13 PFTs(multiply by veget_max_old"), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tGPP                 "), &
+               &               TRIM("total GPP of 13 PFTs (after adjustment)           "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_GROWTH         "), &
+               &               TRIM("total resp growth of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_MAINT          "), &
+               &               TRIM("total resp maint  of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_HETERO         "), &
+               &               TRIM("total resp hetero of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCARBON              "), &
+               &               TRIM("total carbon of 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tBIOMASS             "), &
+               &               TRIM("total biomass of 13 PFTs (after adjustment)       "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tLITTER              "), &
+               &               TRIM("total litter of 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tSOILC               "), &
+               &               TRIM("total soil carbon of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2_TAKEN           "), &
+               &               TRIM("total co2_to_bm 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2_FIRE            "), &
+               &               TRIM("total co2_fire 13 PFTs (after adjustment)         "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+       END IF
+       
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FPC_MAX             "), &
+            &               TRIM("foliage projective cover                          "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MAXFPC_LASTYEAR     "), &
+            &               TRIM("foliage projective cover of last year             "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+       ! "seasonal" 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("TSEASON             "), &
+         &               TRIM("Seasonal 2 m temperature                             "), &
+         &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(10), dt, hist_dt)
+
+       ! how many days after onset                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("TMIN_SPRING_TIME    "), &
+         &               TRIM("how many days after onset                            "), &
+         &               TRIM("days                "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+       !                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("ONSET_DATE          "), &
+         &               TRIM("onset date                                           "), &
+         &               TRIM("day                 "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+       ! Leaf Area Index                                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LAI                 "), &
+            &               TRIM("Leaf Area Index                                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! Maximum vegetation fraction (LAI -> infinity)     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("VEGET_COV_MAX       "), &
+            &               TRIM("Maximum vegetation fraction (LAI -> infinity)     "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! Net primary productivity                          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NPP                 "), &
+            &               TRIM("Net primary productivity                          "), &
+            &               TRIM("gC/day/(m^2 tot)    "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Gross primary productivity                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GPP                 "), &
+            &               TRIM("Gross primary productivity                        "), &
+            &               TRIM("gC/day/m^2          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Density of individuals                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("IND                 "), &
+            &               TRIM("Density of individuals                            "), &
+            &               TRIM("1/ m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Adaptation to climate
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ADAPTATION          "), &
+            &               TRIM("Adaptation to climate (DGVM)                      "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+    
+       ! Probability from regenerative
+       CALL histdef (hist_id_stom, &
+            &               TRIM("REGENERATION        "), &
+            &               TRIM("Probability from regenerative (DGVM)               "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+       
+       ! crown area of individuals (m**2)
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CN_IND              "), &
+            &               TRIM("crown area of individuals                         "), &
+            &               TRIM("m^2                 "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! woodmass of individuals (gC)
+       CALL histdef (hist_id_stom, &
+            &               TRIM("WOODMASS_IND        "), &
+            &               TRIM("Woodmass of individuals                           "), &
+            &               TRIM("gC/pft              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! total living biomass
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_M             "), &
+            &               TRIM("Total living biomass                              "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Leaf mass                                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_M              "), &
+            &               TRIM("Leaf mass                                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Sap mass above ground                             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_M_AB            "), &
+            &               TRIM("Sap mass above ground                             "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Sap mass below ground                             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_M_BE            "), &
+            &               TRIM("Sap mass below ground                             "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Heartwood mass above ground                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_M_AB          "), &
+            &               TRIM("Heartwood mass above ground                       "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Heartwood mass below ground                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_M_BE          "), &
+            &               TRIM("Heartwood mass below ground                       "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Root mass                                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_M              "), &
+            &               TRIM("Root mass                                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Fruit mass                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_M             "), &
+            &               TRIM("Fruit mass                                        "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Carbohydrate reserve mass                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RESERVE_M           "), &
+            &               TRIM("Carbohydrate reserve mass                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! total turnover rate
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_TURN          "), &
+            &               TRIM("total turnover rate                               "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Leaf turnover                                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_TURN           "), &
+            &               TRIM("Leaf turnover                                     "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Sap turnover above                                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_AB_TURN         "), &
+            &               TRIM("Sap turnover above                                "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Root turnover                                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_TURN           "), &
+            &               TRIM("Root turnover                                     "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Fruit turnover                                    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_TURN          "), &
+            &               TRIM("Fruit turnover                                    "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! total conversion of biomass to litter 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_BM_LITTER     "), &
+            &               TRIM("total conversion of biomass to litter             "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Leaf death                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_BM_LITTER      "), &
+            &               TRIM("Leaf death                                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Sap death above ground                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_AB_BM_LITTER    "), &
+            &               TRIM("Sap death above ground                            "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Sap death below ground                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_BE_BM_LITTER    "), &
+            &               TRIM("Sap death below ground                            "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Heartwood death above ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_AB_BM_LITTER  "), &
+            &               TRIM("Heartwood death above ground                      "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Heartwood death below ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_BE_BM_LITTER  "), &
+            &               TRIM("Heartwood death below ground                      "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Root death                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_BM_LITTER      "), &
+            &               TRIM("Root death                                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Fruit death                                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_BM_LITTER     "), &
+            &               TRIM("Fruit death                                       "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Carbohydrate reserve death                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RESERVE_BM_LITTER   "), &
+            &               TRIM("Carbohydrate reserve death                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Maintenance respiration                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MAINT_RESP          "), &
+            &               TRIM("Maintenance respiration                           "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Growth respiration                                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GROWTH_RESP         "), &
+            &               TRIM("Growth respiration                                "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! age                                               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("AGE                 "), &
+            &               TRIM("age                                               "), &
+            &               TRIM("years               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
+       
+       ! height                                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEIGHT              "), &
+            &               TRIM("height                                            "), &
+            &               TRIM("m                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
+
+       ! weekly moisture stress                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MOISTRESS           "), &
+            &               TRIM("weekly moisture stress                            "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Maximum rate of carboxylation                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("VCMAX               "), &
+            &               TRIM("Maximum rate of carboxylation                     "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! leaf age                                          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_AGE            "), &
+            &               TRIM("leaf age                                          "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+       
+       ! Fraction of trees that dies (gap)                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MORTALITY           "), &
+            &               TRIM("Fraction of trees that dies (gap)                 "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Fraction of plants killed by fire                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREDEATH           "), &
+            &               TRIM("Fraction of plants killed by fire                 "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Density of newly established saplings             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("IND_ESTAB           "), &
+            &               TRIM("Density of newly established saplings             "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Establish tree
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ESTABTREE           "), &
+            &               TRIM("Rate of tree establishement                       "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(6), dt, hist_dt)
+
+       ! Establish grass
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ESTABGRASS          "), &
+            &               TRIM("Rate of grass establishement                      "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(6), dt, hist_dt)
+
+       ! Fraction of plants that dies (light competition)  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LIGHT_DEATH         "), &
+            &               TRIM("Fraction of plants that dies (light competition)  "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! biomass allocated to leaves                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_LEAF       "), &
+            &               TRIM("biomass allocated to leaves                       "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to sapwood above ground         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_SAP_AB     "), &
+            &               TRIM("biomass allocated to sapwood above ground         "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to sapwood below ground         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_SAP_BE     "), &
+            &               TRIM("biomass allocated to sapwood below ground         "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to roots                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_ROOT       "), &
+            &               TRIM("biomass allocated to roots                        "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to fruits                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_FRUIT      "), &
+            &               TRIM("biomass allocated to fruits                       "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to carbohydrate reserve         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_RES        "), &
+            &               TRIM("biomass allocated to carbohydrate reserve         "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! time constant of herbivore activity               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HERBIVORES          "), &
+            &               TRIM("time constant of herbivore activity               "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! turnover time for grass leaves                    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TURNOVER_TIME       "), &
+            &               TRIM("turnover time for grass leaves                    "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! 10 year wood product pool                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PROD10              "), &
+            &               TRIM("10 year wood product pool                         "), &
+            &               TRIM("gC/m**2             "), iim,jjm, hist_hori_id, &
+            &               11,1,11, hist_pool_11axis_id,32, ave(5), dt, hist_dt)
+       
+       ! annual flux for each 10 year wood product pool    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FLUX10              "), &
+            &               TRIM("annual flux for each 10 year wood product pool    "), &
+            &               TRIM("gC/m**2/yr          "), iim,jjm, hist_hori_id, &
+            &               10,1,10, hist_pool_10axis_id,32, ave(5), dt, hist_dt)
+       
+       ! 100 year wood product pool                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PROD100             "), &
+            &               TRIM("100 year wood product pool                        "), &
+            &               TRIM("gC/m**2             "), iim,jjm, hist_hori_id, &
+            &               101,1,101, hist_pool_101axis_id,32, ave(5), dt, hist_dt)
+
+       ! annual flux for each 100 year wood product pool   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FLUX100             "), &
+            &               TRIM("annual flux for each 100 year wood product pool   "), &
+            &               TRIM("gC/m**2/yr          "), iim,jjm, hist_hori_id, &
+            &               100,1,100, hist_pool_100axis_id,32, ave(5), dt, hist_dt)
+
+       ! annual release right after deforestation          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CONVFLUX            "), &
+            &               TRIM("annual release right after deforestation          "), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+       ! annual release from all 10 year wood product pools 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CFLUX_PROD10        "), &
+            &               TRIM("annual release from all 10 year wood product pools"), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+       ! annual release from all 100year wood product pools
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CFLUX_PROD100       "), &
+            &               TRIM("annual release from all 100year wood product pools"), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+       ! WOOD HARVEST
+       ! 10 year wood product pool                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PROD10_HARVEST      "), &
+            &               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_HARVEST      "), &
+            &               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_HARVEST     "), &
+            &               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_HARVEST     "), &
+            &               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_HARVEST      "), &
+            &               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_HARVEST   "), &
+            &               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
+       ! Note removed last letter T from HARVEST in the variable name to limit number of authorized charcters
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CFLUX_PROD100_HARVES"), &
+            &               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)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("WOOD_HARVEST  "), &
+            &               TRIM("harvested wood biomass"), &
+            &               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, &
+            &               TRIM("WOOD_HARVEST_PFT  "), &
+            &               TRIM("harvested wood biomass per PFT"), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! agriculure product
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HARVEST_ABOVE       "), &
+            &               TRIM("annual release product after harvest              "), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+
+       CALL histdef(hist_id_stom, 'RESOLUTION_X', 'E-W resolution', 'm', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'RESOLUTION_Y', 'N-S resolution', 'm', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'CONTFRAC', 'Continental fraction', '1', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'Areas', 'Mesh areas', 'm2', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       
+       !  Special outputs for phenology
+       CALL histdef (hist_id_stom, &
+            &               TRIM("WHEN_GROWTHINIT     "), &
+            &               TRIM("Time elapsed from season beginning                "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PFTPRESENT          "), &
+            &               TRIM("PFT exists                                        "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GDD_MIDWINTER       "), &
+            &               TRIM("Growing degree days, since midwinter              "), &
+            &               TRIM("degK                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GDD_M5_DORMANCE     "), &
+            &               TRIM("Growing degree days, since dormance               "), &
+            &               TRIM("degK                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NCD_DORMANCE        "), &
+            &               TRIM("Number of chilling days, since leaves were lost   "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ALLOW_INITPHENO     "), &
+            &               TRIM("Allow to declare beginning of the growing season  "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BEGIN_LEAVES        "), &
+            &               TRIM("Signal to start putting leaves on                 "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+    ENDIF
+
+  END SUBROUTINE ioipslctrl_histstom
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_histstomipcc
+!!
+!>\BRIEF	 This subroutine initialize the IOIPSL stomate second output file (ipcc file)
+!! 
+!! DESCRIPTION   : This subroutine initialize the IOIPSL stomate second output file named stomate_ipcc_history.nc(default name).
+!!                 This subroutine was previously called stom_IPCC_define_history and located in module intersurf.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_histstomipcc( &
+       hist_id_stom_IPCC, nvm, iim, jjm, dt, &
+       hist_dt, hist_hori_id, hist_PFTaxis_id)
+    ! deforestation axis added as arguments
+
+    !---------------------------------------------------------------------
+    !- Tell ioipsl which variables are to be written
+    !- and on which grid they are defined
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    !- Input
+    !-
+    !- File id
+    INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC
+    !- number of PFTs
+    INTEGER(i_std),INTENT(in) :: nvm
+    !- Domain size
+    INTEGER(i_std),INTENT(in) :: iim, jjm
+    !- Time step of STOMATE (seconds)
+    REAL(r_std),INTENT(in)    :: dt
+    !- Time step of history file (s)
+    REAL(r_std),INTENT(in)    :: hist_dt
+    !- id horizontal grid
+    INTEGER(i_std),INTENT(in) :: hist_hori_id
+    !- id of PFT axis
+    INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
+    !-
+    !- 1 local
+    !-
+    !- Character strings to define operations for histdef
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
+
+    !=====================================================================
+    !- 1 define operations
+    !=====================================================================
+    ave(1) =  'ave(scatter(X))'
+    !=====================================================================
+    !- 2 surface fields (2d)
+    !=====================================================================
+    ! Carbon in Vegetation
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cVeg"), &
+         &               TRIM("Carbon in Vegetation"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Litter Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitter"), &
+         &               TRIM("Carbon in Litter Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoil"), &
+         &               TRIM("Carbon in Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Products of Land Use Change
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cProduct"), &
+         &               TRIM("Carbon in Products of Land Use Change"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon Mass Variation
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cMassVariation"), &
+         &               TRIM("Terrestrial Carbon Mass Variation"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Leaf Area Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("lai"), &
+         &               TRIM("Leaf Area Fraction"), &
+         &               TRIM("1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Gross Primary Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("gpp"), &
+         &               TRIM("Gross Primary Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("ra"), &
+         &               TRIM("Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Primary Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("npp"), &
+         &               TRIM("Net Primary Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Heterotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rh"), &
+         &               TRIM("Heterotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Emission from Fire
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fFire"), &
+         &               TRIM("CO2 Emission from Fire"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! CO2 Flux to Atmosphere from Crop Harvesting
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fHarvest"), &
+         &               TRIM("CO2 Flux to Atmosphere from Crop Harvesting"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux to Atmosphere from Land Use Change
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fLuc"), &
+         &               TRIM("CO2 Flux to Atmosphere from Land Use Change"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux to Atmosphere from Wood Harvest                                                                                
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fWoodharvest"), &
+         &               TRIM("CO2 Flux to Atmosphere from Wood Harvest"), &
+         &               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 Stem
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cStem"), &
+         &               TRIM("Carbon in Stem"), &
+         &               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("nppStem"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Stem"), &
+         &               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 writing 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    !! Note the result is always itau_offset=0 as overwrite_time=TRUE
+    REAL(r_std), INTENT(out)                    :: date0_shifted  !! Note the result is always date0_shifted=date0 as overwrite_time=TRUE
+
+
+    !  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)
+    IF (printlev >= 2) WRITE(numout,*) 'Restart file for sechiba: ', 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)
+      nb_restfile_ids=nb_restfile_ids+1
+      restfile_ids(nb_restfile_ids)=rest_id
+    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)
+
+    ! Note by JG
+    ! restini never modifies itau_dep and date0_rest when overwrite_time=TRUE. 
+    ! This means that itau_dep=istp and date0_rest=date0 => rest_julian=in_julian. 
+    ! The result of below IF will therfor always be itau_offset=0 and date0_shifted=date0
+    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
+
+    !=====================================================================
+    !- 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)
+       IF (printlev >= 2) 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)
+       IF (printlev >= 2) 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)
+         nb_restfile_ids=nb_restfile_ids+1
+         restfile_ids(nb_restfile_ids)=rest_id
+       ELSE
+         rest_id_stom=0
+       ENDIF
+       CALL bcast (itau_dep)
+       CALL bcast (date0_rest)
+       CALL bcast (dt_rest)
+       !-
+    ENDIF
+  END SUBROUTINE ioipslctrl_restini
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_restclo
+!!
+!>\BRIEF	 This subroutine close the restart files in ORCHDIEE. 
+!! 
+!! DESCRIPTION   : This subroutine close restart files in ORCHIDEE. IOIPSL is used for writing the restart files. 
+!!                 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_restclo
+  IMPLICIT NONE
+    INTEGER(i_std) :: n
+    
+    IF (is_root_prc) THEN
+      DO n=1,nb_restfile_ids
+        CALL restclo(restfile_ids(nb_restfile_ids))
+      ENDDO
+    ENDIF
+    
+  END SUBROUTINE ioipslctrl_restclo
+    
+
+END MODULE ioipslctrl
Index: /branches/publications/ORCHIDEE-AFP/src_sechiba/qsat_moisture.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/qsat_moisture.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/qsat_moisture.f90	(revision 8430)
@@ -0,0 +1,1206 @@
+! =================================================================================================================================
+! MODULE 	: qsat_moisture
+!
+! CONTACT       : orchidee-help _at_ listes.ipsl.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)
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) ' qsatcalc: temperature too high at ', &
+              &    nbad, ' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsatcalc','diffuco', '', &
+                 &                     'temperature incorect.') ! Warning message
+         ELSE
+            lo = MAXLOC(temp_in(:))
+            WRITE(numout,*) &
+                 &     'Maximum temperature ( ',MAXVAL(temp_in),') found at ',lo(1)
+            WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF ! (nbad > 0)
+ 
+      
+      !! 2.2 Diagnostic pixels where the temperature is too low
+      nbad = COUNT(jt(:) <= min_temp)
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) ' qsatcalc: temperature too low at ', &
+              &    nbad, ' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsatcalc','diffuco', '', &
+                 &                   'temperature incorect.') ! Warning message
+         ELSE
+            lo = MINLOC(temp_in(:))
+            WRITE(numout,*) &
+                 &     'Minimum temperature ( ',MINVAL(temp_in),') found at ',lo(1)
+            WHERE (jt(:) <= min_temp)   jt(:) = min_temp
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF! (nbad > 0)
+ 
+      !! 2.3 Temporary variables needed for interpolation
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         zz_f(ji) = temp_in(ji)-FLOAT(jt(ji))
+         zz_a(ji) = qsfrict(jt(ji))
+         zz_b(ji) = qsfrict(jt(ji)+1)
+         
+      ENDDO ! Loop over # pixels
+      
+      !-
+      !! 3. Interpolation between these two values
+      !-
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         qsat_out(ji) = ((zz_b(ji)-zz_a(ji))*zz_f(ji)+zz_a(ji))/pres_in(ji)
+         
+      ENDDO  ! Loop over # pixels
+
+
+    END SUBROUTINE qsatcalc
+ 
+!! ================================================================================================================================
+!! FUNCTION 	: [DISPENSABLE] qsat_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:99) = 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-AFP/src_sechiba/routing.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/routing.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/routing.f90	(revision 8430)
@@ -0,0 +1,8195 @@
+! =================================================================================================================================
+! MODULE       : routing
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_day, dt_sechiba
+  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,nslm) !! 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)
+       
+       IF (printlev >= 3) 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)
+       
+       IF (printlev>=3) 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)
+       
+       IF (printlev>=3) 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,nslm) !! 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("floodr",flood_diag)
+    CALL xios_orchidee_send_field("floodh",flood_height)
+
+    ! Difference between the end and the beginning of the routing time step [kg/m^2]
+    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)
+    CALL xios_orchidee_send_field("slowflow",slowflow_diag/mille/dt_sechiba) ! previous id name: Qb
+    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,nslm),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=3)                              :: 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)) .AND. name_found > 1 ) THEN
+                IF ( name_found < 10 ) THEN
+                   WRITE(nn,'(I1)')  name_found
+                ELSE IF ( name_found < 100 ) THEN
+                   WRITE(nn,'(I2)')  name_found
+                ELSE IF ( name_found < 1000 ) THEN
+                   WRITE(nn,'(I3)')  name_found
+                ELSE
+                   ! Make sur to increase nn size when adding more cases
+                   CALL ipslerr_p(3, 'routing_diagnostic', &
+                        'Non of the previous values can fit in the new char', &
+                        'Add a new condition to deal with it', '')
+                ENDIF
+                sorted_names(ic) = TRIM(sorted_names(ic))//TRIM(nn)
+                name_found = name_found - 1
+             ENDIF
+          ENDDO
+       ENDIF
+       
+    ENDDO
+    !
+    ! Print to stdout on ROOT_PROC the diagnostics for the largest basins we have found.
+    !
+    IF (printlev>=1) THEN
+       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
+    END IF
+    !
+    ! 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
+    !
+    ic = COUNT(topo_resid .GT. 0.)
+    IF (printlev>=1) THEN
+       WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid)
+       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)
+    END IF
+    
+    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)
+    !
+    ic = COUNT(topo_resid .GT. 0.)
+    IF (printlev>=1) THEN
+       WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid)
+       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 IF
+    
+  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
+
+    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.
+    !
+    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 ( grid_type == regular_lonlat ) 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 ( grid_type == regular_lonlat ) 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 ( grid_type == regular_lonlat ) 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.
+    !
+    IF (printlev >=1) THEN
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       WRITE(numout,*) "Routing : nbvmax = ", nbvmax
+    END IF
+
+    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)
+    ! 
+    !
+    IF (printlev>=1) 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)
+    !
+    !
+    IF (printlev >=3) 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 )
+                !
+                IF (printlev>=3) 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
+    !
+    IF (printlev>=3) THEN
+       WRITE(numout,*) 'KILL BASIN :', ib, tokill, totakeover, basin_id(ib,tokill), basin_id(ib,totakeover)
+    END IF
+    !
+    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))
+    IF (is_root_prc) CALL flinget(fid, 'pond', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,ipond))
+    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
+    
+    IF (printlev>=2) THEN
+       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)
+    END IF
+
+    ! 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
+       IF (printlev>=1) THEN
+          WRITE(numout,*) "Projection arrays for ",callsign," : "
+          WRITE(numout,*) "nbpmax = ",nbpmax, nix, njx
+       END IF
+    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 (printlev>=1) THEN
+       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)
+    END IF
+
+! 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-AFP/src_sechiba/sechiba.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/sechiba.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/sechiba.f90	(revision 8430)
@@ -0,0 +1,2268 @@
+!  ==============================================================================================================================\n
+!  MODULE 	: sechiba
+! 
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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
+  USE constantes
+  USE time, ONLY : one_day, dt_sechiba
+  USE constantes_soil
+  USE pft_parameters
+  USE grid
+  USE diffuco
+  USE condveg
+  USE enerbil
+  USE hydrol
+  USE thermosoil
+  USE sechiba_io_p
+  USE slowproc
+  USE routing
+  USE ioipsl_para
+  USE chemistry
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC sechiba_main, sechiba_initialize, sechiba_clear, sechiba_interface_orchidee_inca, sechiba_xios_initialize
+
+  INTEGER(i_std), SAVE                             :: printlev_loc   !! local printlev for this module
+!$OMP THREADPRIVATE(printlev_loc)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexveg       !! indexing array for the 3D fields of vegetation
+!$OMP THREADPRIVATE(indexveg)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlai       !! indexing array for the 3D fields of vegetation
+!$OMP THREADPRIVATE(indexlai)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnobio     !! indexing array for the 3D fields of other surfaces (ice,
+                                                                     !! lakes, ...)
+!$OMP THREADPRIVATE(indexnobio)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsoil      !! indexing array for the 3D fields of soil types (kjpindex*nstm)
+!$OMP THREADPRIVATE(indexsoil)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexgrnd      !! indexing array for the 3D ground heat profiles (kjpindex*ngrnd)
+!$OMP THREADPRIVATE(indexgrnd)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlayer     !! indexing array for the 3D fields of soil layers in CWRR (kjpindex*nslm)
+!$OMP THREADPRIVATE(indexlayer)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnslm      !! indexing array for the 3D fields of diagnostic soil layers (kjpindex*nslm)
+!$OMP THREADPRIVATE(indexnslm)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexalb       !! indexing array for the 2 fields of albedo
+!$OMP THREADPRIVATE(indexalb)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsnow      !! indexing array for the 3D fields snow layers
+!$OMP THREADPRIVATE(indexsnow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget          !! Fraction of vegetation type (unitless, 0-1)       
+!$OMP THREADPRIVATE(veget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget_max      !! Max. fraction of vegetation type (LAI -> infty, unitless)
+!$OMP THREADPRIVATE(veget_max)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: tot_bare_soil  !! Total evaporating bare soil fraction 
+!$OMP THREADPRIVATE(tot_bare_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: height         !! Vegetation Height (m)
+!$OMP THREADPRIVATE(height)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: totfrac_nobio  !! Total fraction of continental ice+lakes+cities+...
+                                                                     !! (unitless, 0-1)
+!$OMP THREADPRIVATE(totfrac_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: 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 (:)    :: roughheight    !! Effective height for roughness (m)
+!$OMP THREADPRIVATE(roughheight)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: reinf_slope    !! slope coefficient (reinfiltration) 
+!$OMP THREADPRIVATE(reinf_slope)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: shumdiag       !! Mean relative soil moisture in the different levels used 
+                                                                     !! by thermosoil.f90 (unitless, 0-1)
+!$OMP THREADPRIVATE(shumdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: shumdiag_perma !! Saturation degree of the soil 
+!$OMP THREADPRIVATE(shumdiag_perma)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: k_litt         !! litter cond.
+!$OMP THREADPRIVATE(k_litt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: litterhumdiag  !! Litter dryness factor (unitless, 0-1)
+!$OMP THREADPRIVATE(litterhumdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: stempdiag      !! Temperature which controls canopy evolution (K)
+!$OMP THREADPRIVATE(stempdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintveg       !! Water on vegetation due to interception 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qsintveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta2         !! Interception resistance (unitless,0-1)
+!$OMP THREADPRIVATE(vbeta2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3         !! Vegetation resistance (unitless,0-1)
+!$OMP THREADPRIVATE(vbeta3)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3pot      !! Potential vegetation resistance
+!$OMP THREADPRIVATE(vbeta3pot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: gsmean         !! Mean stomatal conductance for CO2 (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)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpot       !! Potential Transpiration (needed for irrigation)
+!$OMP THREADPRIVATE(transpot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintmax       !! Maximum amount of water in the canopy interception 
+                                                                     !! reservoir @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qsintmax)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rveget         !! Surface resistance for the vegetation 
+                                                                     !! @tex $(s m^{-1})$ @endtex
+!$OMP THREADPRIVATE(rveget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rstruct        !! Vegetation structural resistance
+!$OMP THREADPRIVATE(rstruct)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio     !! Snow mass of non-vegetative surfaces 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(snow_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio_age !! Snow age on non-vegetative surfaces (days)
+!$OMP THREADPRIVATE(snow_nobio_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: frac_nobio     !! Fraction of non-vegetative surfaces (continental ice, 
+                                                                     !! lakes, ...) (unitless, 0-1)
+!$OMP THREADPRIVATE(frac_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: assim_param    !! min+max+opt temps, vcmax, vjmax for photosynthesis
+!$OMP THREADPRIVATE(assim_param)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai            !! Surface foliaire
+!$OMP THREADPRIVATE(lai)
+
+!! liuly
+!@chy it should be declared here.@xchen
+!$OMP THREADPRIVATE(lai)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai_cl1            !! @xchen Surface foliaire
+!$OMP THREADPRIVATE(lai_cl1)                                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai_cl2            !! @xchen Surface foliaire
+!$OMP THREADPRIVATE(lai_cl2)                                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai_cl3            !! @xchen Surface foliaire
+!$OMP THREADPRIVATE(lai_cl3)                                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai_cl4            !! @xchen Surface foliaire
+!$OMP THREADPRIVATE(lai_cl4)                                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: laitop            !! @xchen 
+!$OMP THREADPRIVATE(laish)                                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: laidow            !! @xchen 
+!! xchen add vpd for gpp simulation in Amazon                                   
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: VPD              !! Vapor Pressure Deficit (kPa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: ave_VPD              !! Vapor Pressure Deficit (kPa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vcmax_cl1            !! @xchen Surface foliaire
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vcmax_cl2            !! @xchen Surface foliaire
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vcmax_cl3            !! @xchen Surface foliaire
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vcmax_cl4            !! @xchen Surface foliaire
+!! liuly above
+
+  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)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: fraclut        !! Fraction of each landuse tile (0-1, unitless)
+!$OMP THREADPRIVATE(fraclut)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: nwdFraclut     !! Fraction of non-woody vegetation in each landuse tile (0-1, unitless)
+!$OMP THREADPRIVATE(nwdFraclut)
+  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 @tex ($d$) @endtex
+!$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 (:,:)  :: co2_flux       !! CO2 flux (gC/m**2 of average ground/s)
+!$OMP THREADPRIVATE(co2_flux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: co2_to_bm      !! virtual CO2 flux (gC/m**2 of average ground/s)
+!$OMP THREADPRIVATE(co2_to_bm)
+  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 (:,:)  :: soilmoist      !! Total soil moisture content for each layer in hydrol(liquid + ice) (mm)
+!$OMP THREADPRIVATE(soilmoist)
+
+  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)
+CONTAINS
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    sechiba_xios_initialize
+!!
+!>\BRIEF	  Initialize xios dependant defintion before closing context defintion
+!!
+!! DESCRIPTION:	  Initialize xios dependant defintion before closing context defintion
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE sechiba_xios_initialize
+    LOGICAL :: lerr
+    
+    IF (xios_orchidee_ok) THEN  
+      lerr=xios_orchidee_setvar('min_sechiba',min_sechiba)
+      CALL slowproc_xios_initialize
+      CALL condveg_xios_initialize
+      CALL chemistry_xios_initialize
+      CALL thermosoil_xios_initialize
+    END IF
+    IF (printlev_loc>=3) WRITE(numout,*) 'End sechiba_xios_initialize'
+
+  END SUBROUTINE sechiba_xios_initialize
+
+
+
+
+!!  =============================================================================================================================
+!! 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,         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)
+
+!! 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)            :: precip_rain       !! Rain precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_snow       !! Snow precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown            !! Down-welling long-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet             !! Net surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown            !! Down-welling surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air          !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef          !! Coefficients A for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef          !! Coefficients A for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef          !! Coefficients B for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef          !! Coefficients B for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb                !! Surface pressure (hPa)
+
+
+!! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: coastalflow       !! Outflow on coastal points by small basins.
+                                                                                  !! This is the water which flows in a disperse 
+                                                                                  !! way into the ocean
+                                                                                  !! @tex $(kg dt_routing^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: riverflow         !! Outflow of the major rivers.
+                                                                                  !! The flux will be located on the continental 
+                                                                                  !! grid but this should be a coastal point  
+                                                                                  !! @tex $(kg dt_routing^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: tsol_rad          !! Radiative surface temperature 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vevapp            !! Total of evaporation 
+                                                                                  !! @tex $(kg m^{-2} days^{-1})$ @endtex
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf_out         !! Surface specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: 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		  !! Index (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: zmaxh_glo         !! 2D field of constant soil depth (zmaxh) (m)
+    CHARACTER(LEN=80)                                        :: var_name          !! To store variables names for I/O (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Start sechiba_initialize'
+
+    !! 1. Initialize variables on first call
+
+    !! 1.1 Initialize most of sechiba's variables
+    CALL sechiba_init (kjit, kjpij, kjpindex, index, rest_id, lalo)
+    
+    !! 1.3 Initialize stomate's variables
+
+    CALL slowproc_initialize (kjit,          kjpij,        kjpindex,                          &
+                              rest_id,       rest_id_stom, hist_id_stom,   hist_id_stom_IPCC, &
+                              index,         indexveg,     lalo,           neighbours,        &
+                              resolution,    contfrac,     temp_air,                          &
+                              soiltile,      reinf_slope,  deadleaf_cover, assim_param,       &
+                              lai, &
+!!@xchen
+                              lai_cl1,       lai_cl2,      lai_cl3,        lai_cl4,           &
+                              laitop,        laidow,       VPD,            ave_VPD,           &
+                              vcmax_cl1,     vcmax_cl2,    vcmax_cl3,      vcmax_cl4,         & 
+!! liuly above
+                              frac_age,     height,         veget, &
+                              frac_nobio,    njsc,         veget_max,      fraclut,           &
+                              nwdfraclut,    tot_bare_soil,totfrac_nobio,  qsintmax,          &
+                              co2_flux,      co2_to_bm,    fco2_lu,        temp_growth)
+
+
+    netco2flux(:) = zero
+    DO jv = 2,nvm
+       netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv)
+    ENDDO
+    
+    !! 1.4 Initialize diffusion coefficients
+    CALL diffuco_initialize (kjit,    kjpindex, index,                  &
+                             rest_id, lalo,     neighbours, resolution, &
+                             rstruct, tq_cdrag)
+    
+    !! 1.5 Initialize remaining variables of energy budget
+    CALL enerbil_initialize (kjit,     kjpindex,     index,    rest_id,  &
+                             qair,                                       &
+                             temp_sol, temp_sol_new, tsol_rad,           &
+                             evapot,   evapot_corr,  qsurf,    fluxsens, &
+                             fluxlat,  vevapp )
+    
+    
+    !! 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,  soilmoist, swdown) !!xchen add swdown
+
+    
+    !! 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, lai, &
+         emis, albedo, z0m, z0h, roughheight, &
+         frac_snow_veg,frac_snow_nobio)
+    
+
+    !! 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,   soilmoist,       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
+    ENDIF
+    
+    !! 1.13 Write internal variables to output fields
+    z0m_out(:) = z0m(:)
+    z0h_out(:) = z0h(:)
+    emis_out(:) = emis(:) 
+    qsurf_out(:) = qsurf(:)
+
+    !! 2. Output variables only once
+    zmaxh_glo(:) = zmaxh
+    CALL xios_orchidee_send_field("zmaxh",zmaxh_glo)
+
+    IF (printlev_loc>=3) WRITE(numout,*) 'sechiba_initialize done'
+
+  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 hydrol_main for hydrologic processes 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, 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,&
+       & veget_out, lai_out, height_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)            :: 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})??
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: veget_out         !! Fraction of vegetation type (unitless, 0-1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: lai_out           !! Leaf area index (m^2 m^{-2}) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: height_out        !! Vegetation Height (m)
+
+!! 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		  !! Index (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: histvar           !! Computations for history files (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nlut)                    :: histvar2          !! 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_grassfracC3   !! Total fraction occupied by C3 grasses (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_grassfracC4   !! Total fraction occupied by C4 grasses (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_cropfracC3    !! Total fraction occupied by C3 crops (0-1, unitess)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_cropfracC4    !! Total fraction occupied by C4 crops (0-1, unitess)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_treeFracNdlEvg!! Total fraction occupied by treeFracNdlEvg (0-1, unitess)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_treeFracBdlEvg!! Total fraction occupied by treeFracBdlEvg (0-1, unitess)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_treeFracNdlDcd!! Total fraction occupied by treeFracNdlDcd (0-1, unitess)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_treeFracBdlDcd!! Total fraction occupied by treeFracBdlDcd (0-1, unitess)
+    REAL(r_std), DIMENSION(kjpindex)                         :: grndflux          !! Net energy into soil (W/m2)
+    REAL(r_std), DIMENSION(kjpindex,nsnow)                   :: snowliq           !! Liquid water content (m)
+    REAL(r_std), DIMENSION(kjpindex)                         :: snow_age_diag     !! Only for diag, contains xios_default_val
+    REAL(r_std), DIMENSION(kjpindex,nnobio)                  :: snow_nobio_age_diag !! Only for diag, contains xios_default_val
+    REAL(r_std), DIMENSION(kjpindex)                         :: snowage_glob      !! Snow age on total area including snow on vegetated and bare soil and nobio area @tex ($d$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex,nlut)                    :: gpplut            !! GPP on landuse tile, only for diagnostics
+
+  !!@xchen use var_temp to add FAPAR, PAR_xc, LUE and PC in Wu's paper        
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp1                       
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp2                       
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp3                       
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp4 
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp5                       
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp6  
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp7                       
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp8                       
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp9                       
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: var_temp10  
+  !! liuly above
+
+!_ ================================================================================================================================
+
+    IF (printlev_loc>=3) WRITE(numout,*) 'Start sechiba_main kjpindex =',kjpindex
+
+    !! 1. Initialize variables at each time step
+    CALL sechiba_var_init (kjpindex, rau, pb, temp_air) 
+
+    !! 2. Compute diffusion coefficients
+    CALL diffuco_main (kjit, kjpindex, index, indexveg, indexlai, u, v, &
+         & zlev, z0m, z0h, roughheight, temp_sol, temp_air, temp_growth, rau, tq_cdrag, qsurf, qair, pb ,  &
+         & evap_bare_lim, evapot, evapot_corr, snow, flood_frac, flood_res, frac_nobio, snow_nobio, totfrac_nobio, &
+         & swnet, swdown, coszang, ccanopy, humrel, veget, veget_max, lai, &
+         !!@xchen
+         & laitop, laidow, VPD, &
+         & qsintveg, qsintmax, assim_param, &
+         & vbeta, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, gsmean, rveget, rstruct, cimean, gpp, co2_to_bm, &
+         & lalo, neighbours, resolution, ptnlev1, precip_rain, frac_age, tot_bare_soil, frac_snow_veg, frac_snow_nobio, &
+         & hist_id, hist2_id)
+   
+    !! 3. Compute energy balance
+    CALL enerbil_main (kjit, kjpindex, &
+         & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, &
+         & qair, peqAcoef, peqBcoef, pb, rau, vbeta, 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)
+
+ 
+    !! 4. Compute hydrology
+    !! 4.1 Water balance from CWRR module (11 soil layers)
+    CALL hydrol_main (kjit, kjpindex, &
+         & index, indexveg, indexsoil, indexlayer, indexnslm, &
+         & 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, fraclut, reinf_slope,&
+         & rest_id, hist_id, hist2_id,&
+         & contfrac, 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,frac_snow_veg,temp_sol_add, &
+         & mc_layh, mcl_layh, soilmoist, swdown)!!xchen add swdown
+
+         
+    !! 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, lai, &
+         emis, albedo, z0m, z0h, roughheight, &
+         frac_snow_veg, frac_snow_nobio)
+
+
+    !! 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, soilmoist, 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
+
+       CALL xios_orchidee_send_field("coastalflow",coastalflow/dt_sechiba)
+       CALL xios_orchidee_send_field("riverflow",riverflow/dt_sechiba)
+    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, fraclut, nwdFraclut, &
+         temp_air, temp_sol, stempdiag, &
+         vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+         deadleaf_cover, &
+         assim_param, &
+         lai, &
+   !!@xchen lai_cl1-4 of leaf age class 1-4
+         lai_cl1, lai_cl2, lai_cl3, lai_cl4, laitop, laidow, VPD, ave_VPD, &
+         vcmax_cl1, vcmax_cl2, vcmax_cl3, vcmax_cl4, &      
+   !! liuly above      
+         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, co2_to_bm, temp_growth, tot_bare_soil,&
+         swdown)!!liulyc liulyw xuhui's crop but xchen used it.
+
+    !! 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(:)
+    veget_out(:,:)  = veget(:,:)
+    lai_out(:,:)    = lai(:,:)
+    height_out(:,:) = height(:,:)
+ 
+    !! 12. Write global variables to history files
+    sum_treefrac(:) = zero
+    sum_grassfracC3(:) = zero
+    sum_grassfracC4(:) = zero
+    sum_cropfracC3(:) = zero
+    sum_cropfracC4(:) = zero
+    sum_treeFracNdlEvg(:) = zero
+    sum_treeFracBdlEvg(:) = zero
+    sum_treeFracNdlDcd(:) = zero
+    sum_treeFracBdlDcd(:) = 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
+          ! Grass
+          IF (is_c4(jv)) THEN
+             sum_grassfracC4(:) = sum_grassfracC4(:) + veget_max(:,jv)
+          ELSE
+             sum_grassfracC3(:) = sum_grassfracC3(:) + veget_max(:,jv)
+          END IF
+       ELSE 
+          ! Crop and trees not natural
+          IF (is_c4(jv)) THEN
+             sum_cropfracC4(:) = sum_cropfracC4(:) + veget_max(:,jv)
+          ELSE
+             sum_cropfracC3(:) = sum_cropfracC3(:) + veget_max(:,jv)
+          END IF
+       ENDIF
+
+       IF (is_tree(jv)) THEN
+          IF (is_evergreen(jv)) THEN
+             IF (is_needleleaf(jv)) THEN
+                ! Fraction for needleleaf evergreen trees (treeFracNdlEvg)
+                sum_treeFracNdlEvg(:) = sum_treeFracNdlEvg(:) + veget_max(:,jv)
+             ELSE
+                ! Fraction for broadleaf evergreen trees (treeFracBdlEvg)
+                sum_treeFracBdlEvg(:) = sum_treeFracBdlEvg(:) + veget_max(:,jv)
+             END IF
+          ELSE IF (is_deciduous(jv)) THEN
+             IF (is_needleleaf(jv)) THEN
+                ! Fraction for needleleaf deciduous trees (treeFracNdlDcd)
+                sum_treeFracNdlDcd(:) = sum_treeFracNdlDcd(:) + veget_max(:,jv)
+             ELSE 
+                ! Fraction for broadleafs deciduous trees (treeFracBdlDcd)
+                sum_treeFracBdlDcd(:) = sum_treeFracBdlDcd(:) + veget_max(:,jv)
+             END IF
+          END IF
+       END IF
+    ENDDO          
+
+    histvar(:)=zero
+    DO jv = 2, nvm
+       IF (is_deciduous(jv)) THEN
+          histvar(:) = histvar(:) + veget_max(:,jv)*100*contfrac
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("treeFracPrimDec",histvar)
+
+    histvar(:)=zero
+    DO jv = 2, nvm
+       IF (is_evergreen(jv)) THEN
+          histvar(:) = histvar(:) + veget_max(:,jv)*100*contfrac
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("treeFracPrimEver",histvar)
+
+    histvar(:)=zero
+    DO jv = 2, nvm
+       IF ( .NOT.(is_c4(jv)) ) THEN
+          histvar(:) = histvar(:) + veget_max(:,jv)*100*contfrac
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("c3PftFrac",histvar)
+
+    histvar(:)=zero
+    DO jv = 2, nvm
+       IF ( is_c4(jv) ) THEN
+          histvar(:) = histvar(:) + veget_max(:,jv)*100*contfrac
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("c4PftFrac",histvar)
+
+    CALL xios_orchidee_send_field("temp_sol_new",temp_sol_new)
+    CALL xios_orchidee_send_field("fluxsens",fluxsens)
+    CALL xios_orchidee_send_field("fluxlat",fluxlat)
+
+
+    ! Add XIOS default value where no snow
+    DO ji=1,kjpindex 
+       IF (snow(ji) .GT. zero) THEN
+          snow_age_diag(ji) = snow_age(ji)
+          snow_nobio_age_diag(ji,:) = snow_nobio_age(ji,:)
+       
+          snowage_glob(ji) = snow_age(ji)*frac_snow_veg(ji)*(1-totfrac_nobio(ji)) + &
+               SUM(snow_nobio_age(ji,:)*frac_snow_nobio(ji,:)*frac_nobio(ji,:))
+          IF (snowage_glob(ji) .NE. 0) snowage_glob(ji) = snowage_glob(ji) / &
+               (frac_snow_veg(ji)*(1-totfrac_nobio(ji)) + SUM(frac_snow_nobio(ji,:)*frac_nobio(ji,:)))
+       ELSE
+          snow_age_diag(ji) = xios_default_val
+          snow_nobio_age_diag(ji,:) = xios_default_val
+          snowage_glob(ji) = xios_default_val
+       END IF
+    END DO
+    
+    CALL xios_orchidee_send_field("snow",snow)
+    CALL xios_orchidee_send_field("snowage",snow_age_diag)
+    CALL xios_orchidee_send_field("snownobio",snow_nobio)
+    CALL xios_orchidee_send_field("snownobioage",snow_nobio_age_diag)
+    CALL xios_orchidee_send_field("snowage_glob",snowage_glob)
+
+    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("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("gpp_ipcc2",SUM(gpp,dim=2)/dt_sechiba)
+
+    histvar(:)=zero
+    DO jv = 2, nvm
+       IF ( .NOT. is_tree(jv) .AND. natural(jv) ) THEN
+          histvar(:) = histvar(:) + gpp(:,jv)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("gppgrass",histvar/dt_sechiba)
+
+    histvar(:)=zero
+    DO jv = 2, nvm
+       IF ( (.NOT. is_tree(jv)) .AND. (.NOT. natural(jv)) ) THEN
+          histvar(:) = histvar(:) + gpp(:,jv)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("gppcrop",histvar/dt_sechiba)
+
+    histvar(:)=zero
+    DO jv = 2, nvm
+       IF ( is_tree(jv) ) THEN
+          histvar(:) = histvar(:) + gpp(:,jv)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("gpptree",histvar/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("vevapflo",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)
+
+    ! For CMIP6 data request: the following fractions are fractions of the total grid-cell,
+    ! which explains the multiplication by contfrac
+    CALL xios_orchidee_send_field("treeFrac",sum_treefrac(:)*100*contfrac(:))
+    CALL xios_orchidee_send_field("grassFracC3",sum_grassfracC3(:)*100*contfrac(:))
+    CALL xios_orchidee_send_field("grassFracC4",sum_grassfracC4(:)*100*contfrac(:))
+    CALL xios_orchidee_send_field("cropFracC3",sum_cropfracC3(:)*100*contfrac(:))
+    CALL xios_orchidee_send_field("cropFracC4",sum_cropfracC4(:)*100*contfrac(:))
+    CALL xios_orchidee_send_field("treeFracNdlEvg",sum_treeFracNdlEvg(:)*100*contfrac(:))
+    CALL xios_orchidee_send_field("treeFracBdlEvg",sum_treeFracBdlEvg(:)*100*contfrac(:))
+    CALL xios_orchidee_send_field("treeFracNdlDcd",sum_treeFracNdlDcd(:)*100*contfrac(:))
+    CALL xios_orchidee_send_field("treeFracBdlDcd",sum_treeFracBdlDcd(:)*100*contfrac(:))
+
+    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)
+
+    ! For CMIP6 data request: cnc = canopy cover fraction over land area
+    histvar(:)=zero
+    DO jv=2,nvm
+       histvar(:) = histvar(:) + veget_max(:,jv)*100
+    END DO
+    CALL xios_orchidee_send_field("cnc",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)
+    CALL xios_orchidee_send_field("lai",lai)
+
+!!@xchen add PC_wu
+    !!@xchen add FAPAR=(1-p1)-(1-p2)*exp(-0.5*lai/coszang); p1=0.05 and p2=0 for tower site Santarem km67
+    !!umol photons/m^2/si
+    !!lue:0.0088176, 0.02162689,0.034436,0.0211652 for lai_cl1-4                                                         
+    var_temp1(:,:) = zero                                                       
+    var_temp2(:,:) = zero                                                       
+    var_temp3(:,:) = zero                                                       
+    var_temp4(:,:) = zero
+    var_temp5(:,:) = zero                                                       
+    var_temp6(:,:) = zero
+    var_temp7(:,:) = zero                                                       
+    var_temp8(:,:) = zero                                                       
+    var_temp9(:,:) = zero                                                       
+    var_temp10(:,:) = zero                                                                                                            
+                                                                                
+    DO jv = 1,nvm                                                               
+       var_temp1(:,jv) = 1-0.05-exp(-0.5*lai(:,jv)/coszang(:))                  
+       !!var_temp2(:,jv) = 0.0088176*lai_cl1(:,jv)+0.02162689*lai_cl2(:,jv)+0.034436*lai_cl3(:,jv)+0.0211652*lai_cl4(:,jv)
+       var_temp2(:,jv) = 0.0288176*lai_cl1(:,jv)+0.034436*lai_cl2(:,jv)+0.0211652*lai_cl3(:,jv)+0.00211652*lai_cl4(:,jv)  
+       var_temp5(:,jv) = vcmax_cl1(:,jv)/1210.432*lai_cl1(:,jv)+vcmax_cl2(:,jv)/1146.755*lai_cl2(:,jv)+ &
+                         & vcmax_cl3(:,jv)/1083.079*lai_cl3(:,jv)+vcmax_cl4(:,jv)/1102.139*lai_cl4(:,jv)
+ 
+       !!WHERE (var_temp2(:,jv) .GT. zero .AND. var_temp1(:,jv) .GT. zero)      
+       var_temp3(:,jv) = lai_cl1(:,jv)+lai_cl2(:,jv)+lai_cl3(:,jv)+lai_cl4(:,jv)                        
+       var_temp4(:,jv) = var_temp1(:,jv)*var_temp2(:,jv)/var_temp3(:,jv)
+       var_temp6(:,jv) = var_temp1(:,jv)*var_temp5(:,jv)/var_temp3(:,jv)        
+       var_temp7(:,jv) = vcmax_cl1(:,jv)/1210.432*swdown(:)*W_to_mol*RG_to_PAR*var_temp1(:,jv)
+       var_temp8(:,jv) = vcmax_cl2(:,jv)/1146.755*swdown(:)*W_to_mol*RG_to_PAR*var_temp1(:,jv) 
+       var_temp9(:,jv) = vcmax_cl3(:,jv)/1083.079*swdown(:)*W_to_mol*RG_to_PAR*var_temp1(:,jv)
+       var_temp10(:,jv) = vcmax_cl4(:,jv)/1102.139*swdown(:)*W_to_mol*RG_to_PAR*var_temp1(:,jv) 
+       !!var_temp4(:,jv) = var_temp1(:,jv)*var_temp2(:,jv)                                              
+       !!var_temp3(:,jv) = var_temp2(:,jv)*var_temp1(:,jv)                      
+       !!ENDWHERE                                                               
+    ENDDO    
+    !liulyt
+    ! WRITE(numout,*) 'liuly sum of lai_cl1-4 in sechiba main,pft0', var_temp3(:,0)
+    ! WRITE(numout,*) 'liuly sum of lai_cl1-4 in sechiba main,pft1', var_temp3(:,1)
+    ! WRITE(numout,*) 'liuly sum of lai_cl1-4 in sechiba main,pft2', var_temp3(:,2)
+    ! WRITE(numout,*) 'liuly sum of GPPxc_cl1-4 in sechiba main', var_temp7+var_temp8+var_temp9+var_temp10
+    !liulyt
+
+    CALL xios_orchidee_send_field("PC_wu",var_temp4)
+    CALL xios_orchidee_send_field("PC_xc",2.5*var_temp6)                            
+    CALL xios_orchidee_send_field("GPP_CL1",var_temp7) 
+    CALL xios_orchidee_send_field("GPP_CL2",var_temp8)
+    CALL xios_orchidee_send_field("GPP_CL3",var_temp9)
+    CALL xios_orchidee_send_field("GPP_CL4",var_temp10)
+    CALL xios_orchidee_send_field("GPP_xc",var_temp7+var_temp8+var_temp9+var_temp10)
+!! liuly above
+
+    histvar(:)=zero   
+    DO ji = 1, kjpindex
+       IF (SUM(veget_max(ji,:)) > zero) THEN
+         DO jv=2,nvm
+            histvar(ji) = histvar(ji) + veget_max(ji,jv)*lai(ji,jv)/SUM(veget_max(ji,:))
+         END DO
+       END IF
+    END DO
+!! liulya xchen add some lines to PET but seems unsless in his code, so not copy to here Note
+
+    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/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)
+
+
+    !! Calculate diagnostic variables on Landuse tiles for LUMIP/CMIP6
+
+    ! Calculate fraction of landuse tiles related to the whole grid cell
+    DO jv=1,nlut
+       histvar2(:,jv) = fraclut(:,jv) * contfrac(:)
+    END DO
+    CALL xios_orchidee_send_field("fraclut",histvar2)
+
+    CALL xios_orchidee_send_field("nwdFraclut",nwdFraclut(:,:))
+   
+    ! Calculate GPP on landuse tiles
+    ! val_exp is used as missing value where the values are not known i.e. where the tile is not represented 
+    ! or for pasture (id_pst) or urban land (id_urb). 
+    gpplut(:,:)=0
+    DO jv=1,nvm
+       IF (natural(jv)) THEN
+          gpplut(:,id_psl) = gpplut(:,id_psl) + gpp(:,jv)
+       ELSE
+          gpplut(:,id_crp) = gpplut(:,id_crp) + gpp(:,jv)
+       ENDIF
+    END DO
+
+    ! Transform from gC/m2/s into kgC/m2/s
+    WHERE (fraclut(:,id_psl)>min_sechiba)
+       gpplut(:,id_psl) = gpplut(:,id_psl)/fraclut(:,id_psl)/1000
+    ELSEWHERE
+       gpplut(:,id_psl) = xios_default_val
+    END WHERE
+    WHERE (fraclut(:,id_crp)>min_sechiba)
+       gpplut(:,id_crp) = gpplut(:,id_crp)/fraclut(:,id_crp)/1000
+    ELSEWHERE
+       gpplut(:,id_crp) = xios_default_val
+    END WHERE
+    gpplut(:,id_pst) = xios_default_val
+    gpplut(:,id_urb) = xios_default_val
+
+    CALL xios_orchidee_send_field("gpplut",gpplut)
+
+
+    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)
+       CALL histwrite_p(hist_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'subli', kjit, vevapsno, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapnu', kjit, vevapnu, kjpindex, index)
+       CALL histwrite_p(hist_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+       CALL histwrite_p(hist_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+       CALL histwrite_p(hist_id, 'vbeta5', kjit, vbeta5, kjpindex, index)    
+       CALL histwrite_p(hist_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+       CALL histwrite_p(hist_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+       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
+
+       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_grassfracC3(:)+sum_grassfracC4(:))*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'grassFrac', kjit, histvar, kjpindex, index) 
+
+       histvar(:)= (sum_cropfracC3(:)+sum_cropfracC4(:))*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'cropFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=veget_max(:,1)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'baresoilFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(frac_nobio(:,1:nnobio),dim=2)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'residualFrac', kjit, histvar, kjpindex, index)
+    ELSE
+       ! Write history file in ALMA format 
+       CALL histwrite_p(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, '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 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)
+          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)
+          
+          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
+
+
+    !! Change the vegetation fractions if a new map was read in slowproc. This is done 
+    !! after lcchange has been done in stomatelpj
+    IF (done_stomate_lcchange) THEN
+       CALL slowproc_change_frac(kjpindex, lai, &
+                                 veget_max, veget, frac_nobio, totfrac_nobio, tot_bare_soil, soiltile, fraclut, nwdFraclut)
+       done_stomate_lcchange=.FALSE.
+    END IF
+
+    !! 14. If it is the last time step, write restart files
+    IF (ldrestart_write) THEN
+       CALL sechiba_finalize( &
+            kjit,     kjpij,  kjpindex, index,   rest_id, &
+            tq_cdrag, vevapp, fluxsens, fluxlat, tsol_rad)
+    END IF
+
+  END SUBROUTINE sechiba_main
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    sechiba_finalize
+!!
+!>\BRIEF	  Finalize all modules by calling their "_finalize" subroutines.
+!!
+!! DESCRIPTION:	  Finalize all modules by calling their "_finalize" subroutines. These subroutines will write variables to 
+!!                restart file. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE sechiba_finalize( &
+       kjit,     kjpij,  kjpindex, index,   rest_id, &
+       tq_cdrag, vevapp, fluxsens, fluxlat, tsol_rad)
+
+!! 0.1 Input variables    
+    INTEGER(i_std), INTENT(in)                               :: kjit              !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpij             !! Total size of the un-compressed grid 
+                                                                                  !! (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpindex          !! Domain size - terrestrial pixels only 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id           !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: index             !! Indices of the pixels on the map. 
+                                                                                  !! Sechiba uses a reduced grid excluding oceans
+                                                                                  !! ::index contains the indices of the 
+                                                                                  !! terrestrial pixels only! (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: tsol_rad           !! Radiative surface temperature 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: vevapp             !! Total of evaporation 
+                                                                                  !! @tex $(kg m^{-2} days^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: fluxsens           !! Sensible heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: fluxlat            !! Latent heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: tq_cdrag           !! Surface drag coefficient (-)
+
+!! 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_loc>=3) WRITE (numout,*) 'Start sechiba_finalize for writing restart files'
+
+    !! 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
+    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
+    
+    !! 7. Call slowproc_main to add 'daily' and annual variables to restart file
+    CALL slowproc_finalize (kjit,       kjpindex,  rest_id,  index,      &
+                            njsc,       lai,       height,   veget,      &
+                            frac_nobio, veget_max, reinf_slope,          &
+                            co2_to_bm,  assim_param, frac_age)
+    
+    IF (printlev_loc>=3) WRITE (numout,*) 'sechiba_finalize done'
+    
+  END SUBROUTINE sechiba_finalize
+
+  
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_init
+!!
+!>\BRIEF        Dynamic allocation of the variables, the dimensions of the 
+!! variables are determined by user-specified settings. 
+!! 
+!! DESCRIPTION  : The domain size (:: kjpindex) is used to allocate the correct
+!! dimensions to all variables in sechiba. Depending on the variable, its 
+!! dimensions are also determined by the number of PFT's (::nvm), number of 
+!! soil types (::nstm), number of non-vegetative surface types (::nnobio),
+!! number of soil levels (::ngrnd), number of soil layers in the hydrological 
+!! model (i.e. cwrr) (::nslm). Values for these variables are set in
+!! constantes_soil.f90 and constantes_veg.f90.\n
+!!
+!! Memory is allocated for all Sechiba variables and new indexing tables
+!! are build making use of both (::kjpij) and (::kjpindex). New indexing tables 
+!! are needed because a single pixel can contain several PFTs, soil types, etc.
+!! The new indexing tables have separate indices for the different
+!! PFTs, soil types, etc.\n
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory and builds new indexing 
+!! variables for later use.
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================ 
+
+  SUBROUTINE sechiba_init (kjit, kjpij, kjpindex, index, rest_id, lalo)
+
+!! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number (unitless)
+    INTEGER(i_std), INTENT (in)                         :: kjpij              !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map (unitless)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo               !! Geographical coordinates (latitude,longitude) 
+                                                                              !! for pixels (degrees)
+!! 0.2 Output variables
+
+!! 0.3 Modified variables
+
+!! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ier                !! Check errors in memory allocation (unitless)
+    INTEGER(i_std)                                      :: ji, jv             !! Indeces (unitless)
+!_ ==============================================================================================================================
+
+!! 1. Initialize variables 
+    
+    ! Dynamic allocation with user-specified dimensions on first call
+    IF (l_first_sechiba) THEN 
+       l_first_sechiba=.FALSE.
+    ELSE 
+       CALL ipslerr_p(3,'sechiba_init',' l_first_sechiba false . we stop ','','')
+    ENDIF
+
+    !! Initialize local printlev
+    printlev_loc=get_printlev('sechiba')
+    
+
+    !! 1.1 Initialize 3D vegetation indexation table
+    ALLOCATE (indexveg(kjpindex*nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexveg','','')
+
+    ALLOCATE (indexlai(kjpindex*(nlai+1)),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexlai','','')
+
+    ALLOCATE (indexsoil(kjpindex*nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexsoil','','')
+
+    ALLOCATE (indexnobio(kjpindex*nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexnobio','','')
+
+    ALLOCATE (indexgrnd(kjpindex*ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexgrnd','','')
+
+    ALLOCATE (indexsnow(kjpindex*nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexsnow','','')
+
+    ALLOCATE (indexlayer(kjpindex*nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexlayer','','')
+
+    ALLOCATE (indexnslm(kjpindex*nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexnslm','','')
+
+    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 (fraclut(kjpindex,nlut),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for fraclut','','')
+
+    ALLOCATE (nwdFraclut(kjpindex,nlut),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for nwdFraclut','','')
+
+    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
+
+!! liuly
+!!@chy: lai_cl1/2/3/4 has to be allocated here. @xchen
+    ALLOCATE (lai_cl1(kjpindex,nvm),stat=ier)                                       
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lai_cl1','','')  
+    lai_cl1(:,:)=undef_sechiba
+    ALLOCATE (lai_cl2(kjpindex,nvm),stat=ier)                                   
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lai_cl2','','')  
+    lai_cl2(:,:)=undef_sechiba
+    ALLOCATE (lai_cl3(kjpindex,nvm),stat=ier)                                   
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lai_cl3','','')  
+    lai_cl3(:,:)=undef_sechiba 
+    ALLOCATE (lai_cl4(kjpindex,nvm),stat=ier)                                   
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lai_cl4','','')  
+    lai_cl4(:,:)=undef_sechiba 
+    ALLOCATE (VPD(kjpindex),stat=ier)                                    
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for VPD','','')
+    VPD(:)=undef_sechiba 
+    ALLOCATE (ave_VPD(kjpindex),stat=ier)                                           
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for ave_VPD','','')  
+    ave_VPD(:)=undef_sechiba    
+    ALLOCATE (laitop(kjpindex,nvm),stat=ier)                                    
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for laitop','','')
+    laitop(:,:)=undef_sechiba                                                   
+    ALLOCATE (laidow(kjpindex,nvm),stat=ier)                                     
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for laidow','','')
+    laidow(:,:)=undef_sechiba  
+    ALLOCATE (vcmax_cl1(kjpindex,nvm),stat=ier)                                   
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vcmax_cl1','','')
+    vcmax_cl1(:,:)=undef_sechiba  
+    ALLOCATE (vcmax_cl2(kjpindex,nvm),stat=ier)                                 
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vcmax_cl2','','')
+    vcmax_cl2(:,:)=undef_sechiba 
+    ALLOCATE (vcmax_cl3(kjpindex,nvm),stat=ier)                                 
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vcmax_cl3','','')
+    vcmax_cl3(:,:)=undef_sechiba 
+    ALLOCATE (vcmax_cl4(kjpindex,nvm),stat=ier)                                 
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vcmax_cl4','','')
+    vcmax_cl4(:,:)=undef_sechiba 
+!! liuly above
+
+
+
+    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 (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, nslm),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 (co2_to_bm(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for co2_to_bm','','')
+
+    ALLOCATE (shumdiag(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for shumdiag','','')
+    
+    ALLOCATE (shumdiag_perma(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for shumdiag_perma','','')
+
+    ALLOCATE (litterhumdiag(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for litterhumdiag','','')
+
+    ALLOCATE (ptnlev1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for ptnlev1','','')
+
+    ALLOCATE (k_litt(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for k_litt','','')
+
+    !! 1.5 Initialize 2D array allocation
+    ALLOCATE (vevapwet(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapwet','','')
+    vevapwet(:,:)=undef_sechiba
+
+    ALLOCATE (transpir(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for transpir','','')
+
+    ALLOCATE (transpot(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for transpot','','')
+
+    ALLOCATE (qsintmax(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for qsintmax','','')
+
+    ALLOCATE (rveget(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rveget','','')
+
+    ALLOCATE (rstruct(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rstruct','','')
+
+    ALLOCATE (pgflux(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for pgflux','','')
+    pgflux(:)= 0.0
+
+    ALLOCATE (cgrnd_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for cgrnd_snow','','')
+    cgrnd_snow(:,:) = 0
+
+    ALLOCATE (dgrnd_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for dgrnd_snow','','')
+    dgrnd_snow(:,:) = 0
+
+    ALLOCATE (lambda_snow(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lambda_snow','','')
+    lambda_snow(:) = 0
+
+    ALLOCATE (temp_sol_add(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for temp_sol_add','','')
+
+    ALLOCATE (gtemp(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for gtemp','','')
+
+    ALLOCATE (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 (soilmoist(kjpindex, nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for soilmoist','','')
+
+    !! 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, nslm
+          indexnslm((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+
+       DO jv = 1, nslm
+          indexlayer((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, 2
+          indexalb((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+    ENDDO
+
+!! 2. Read the default value that will be put into variable which are not in the restart file
+    CALL ioget_expval(val_exp)
+    
+    IF (printlev_loc>=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 (indexnslm)) DEALLOCATE (indexnslm)
+    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 (fraclut)) DEALLOCATE (fraclut)
+    IF ( ALLOCATED (nwdFraclut)) DEALLOCATE (nwdFraclut)
+    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)
+
+!! liuly
+!@chy: these lines below are needed.
+!!@xchen
+    IF ( ALLOCATED (lai_cl1)) DEALLOCATE (lai_cl1)                                      
+    IF ( ALLOCATED (lai_cl2)) DEALLOCATE (lai_cl2)                              
+    IF ( ALLOCATED (lai_cl3)) DEALLOCATE (lai_cl3)                              
+    IF ( ALLOCATED (lai_cl4)) DEALLOCATE (lai_cl4)   
+    IF ( ALLOCATED (VPD)) DEALLOCATE (VPD)   
+    IF ( ALLOCATED (ave_VPD)) DEALLOCATE (ave_VPD)                                                          
+    IF ( ALLOCATED (laitop)) DEALLOCATE (laitop)                                
+    IF ( ALLOCATED (laidow)) DEALLOCATE (laidow) 
+    IF ( ALLOCATED (vcmax_cl1)) DEALLOCATE (vcmax_cl1)                              
+    IF ( ALLOCATED (vcmax_cl2)) DEALLOCATE (vcmax_cl2)                          
+    IF ( ALLOCATED (vcmax_cl3)) DEALLOCATE (vcmax_cl3)                          
+    IF ( ALLOCATED (vcmax_cl4)) DEALLOCATE (vcmax_cl4)  
+!! liuly above
+
+    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 (co2_to_bm)) DEALLOCATE (co2_to_bm)
+    IF ( ALLOCATED (shumdiag)) DEALLOCATE (shumdiag)
+    IF ( ALLOCATED (shumdiag_perma)) DEALLOCATE (shumdiag_perma)
+    IF ( ALLOCATED (litterhumdiag)) DEALLOCATE (litterhumdiag)
+    IF ( ALLOCATED (ptnlev1)) DEALLOCATE (ptnlev1)
+    IF ( ALLOCATED (k_litt)) DEALLOCATE (k_litt)
+    IF ( ALLOCATED (vevapwet)) DEALLOCATE (vevapwet)
+    IF ( ALLOCATED (transpir)) DEALLOCATE (transpir)
+    IF ( ALLOCATED (transpot)) DEALLOCATE (transpot)
+    IF ( ALLOCATED (qsintmax)) DEALLOCATE (qsintmax)
+    IF ( ALLOCATED (rveget)) DEALLOCATE (rveget)
+    IF ( ALLOCATED (rstruct)) DEALLOCATE (rstruct)
+    IF ( ALLOCATED (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 (soilmoist)) DEALLOCATE (soilmoist)
+
+!! 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_loc>=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_loc>=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-AFP/src_sechiba/sechiba_io_p.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/sechiba_io_p.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/sechiba_io_p.f90	(revision 8430)
@@ -0,0 +1,587 @@
+! ================================================================================================================================
+!  MODULE       : sechiba_io_p
+!
+!  CONTACT      : orchidee-help _at_ listes.ipsl.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
+  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
+
+END MODULE sechiba_io_p
Index: /branches/publications/ORCHIDEE-AFP/src_sechiba/slowproc.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/slowproc.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/slowproc.f90	(revision 8430)
@@ -0,0 +1,3969 @@
+
+! =================================================================================================================================
+! MODULE       : slowproc
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Groups the subroutines that: (1) initialize all variables used in 
+!! slowproc_main, (2) prepare the restart file for the next simulation, (3) Update the 
+!! vegetation cover if needed, and (4) handle all slow processes if the carbon
+!! cycle is activated (call STOMATE) or update the vegetation properties (LAI and 
+!! fractional cover) in the case of a run with only SECHIBA.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Allowed reading of USDA map, Nov 2014, ADucharne
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE slowproc
+
+  USE defprec
+  USE constantes 
+  USE constantes_soil
+  USE pft_parameters
+  USE ioipsl
+  USE xios_orchidee
+  USE ioipsl_para
+  USE sechiba_io_p
+  USE interpol_help
+  USE stomate
+  USE stomate_data
+  USE grid
+  USE time, ONLY : dt_sechiba, dt_stomate, one_day, FirstTsYear, LastTsDay
+  USE time, ONLY : year_start, month_start, day_start, sec_start
+  USE time, ONLY : month_end, day_end
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC slowproc_main, slowproc_clear, slowproc_initialize, slowproc_finalize, slowproc_change_frac, slowproc_xios_initialize
+
+  !
+  ! variables used inside slowproc module : declaration and initialisation
+  !
+  REAL(r_std), SAVE                                  :: slope_default = 0.1
+!$OMP THREADPRIVATE(slope_default)
+  INTEGER, SAVE                                      :: printlev_loc        !! Local printlev in slowproc module
+!$OMP THREADPRIVATE(printlev_loc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: clayfraction        !! Clayfraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: sandfraction        !! Sandfraction (0-1, unitless)
+!$OMP THREADPRIVATE(sandfraction)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: siltfraction        !! Siltfraction (0-1, unitless)
+!$OMP THREADPRIVATE(siltfraction)  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: laimap              !! LAI map when the LAI is prescribed and not calculated by STOMATE
+!$OMP THREADPRIVATE(laimap)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: soilclass_default
+!$OMP THREADPRIVATE(soilclass_default)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: veget_max_new       !! New year fraction of vegetation type (0-1, unitless)
+!$OMP THREADPRIVATE(veget_max_new)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: woodharvest         !! New year wood harvest
+!$OMP THREADPRIVATE(woodharvest)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_nobio_new      !! New year fraction of ice+lakes+cities+... (0-1, unitless)
+!$OMP THREADPRIVATE(frac_nobio_new)
+  INTEGER(i_std), SAVE                               :: lcanop              !! canopy levels used for LAI
+!$OMP THREADPRIVATE(lcanop)
+  INTEGER(i_std) , SAVE                              :: veget_year          !! year for vegetation update
+!$OMP THREADPRIVATE(veget_year)
+
+CONTAINS
+
+
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    slowproc_xios_initialize
+!!
+!>\BRIEF	  Initialize xios dependant defintion before closing context defintion
+!!
+!! DESCRIPTION:	  Initialize xios dependant defintion before closing context defintion
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE slowproc_xios_initialize
+
+    CHARACTER(LEN=255) :: filename, name
+    LOGICAL :: lerr
+    REAL(r_std) :: slope_noreinf
+    LOGICAL :: get_slope
+    CHARACTER(LEN=30) :: veget_str         !! update frequency for landuse    
+    INTEGER :: l
+
+    IF (printlev>=3) WRITE(numout,*) 'In slowproc_xios_initialize'
+    !! 1. Prepare for reading of soils_param file
+    ! Get the file name from run.def file and set file attributes accordingly
+    filename = 'soils_param.nc'
+    CALL getin_p('SOILCLASS_FILE',filename)
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    CALL xios_orchidee_set_file_attr("soils_param_file",name=name)
+
+    ! Determine if soils_param_file will be read. If not, deactivate the file.    
+    IF (xios_interpolation .AND. restname_in=='NONE' .AND. .NOT. impsoilt) THEN
+       ! Reading will be done with XIOS later
+       IF (printlev>=2) WRITE(numout,*) 'Reading of soils_param file will be done later using XIOS. The filename is ', filename
+    ELSE
+       ! No reading, deactivate soils_param_file
+       IF (printlev>=2) WRITE(numout,*) 'Reading of soils_param file will not be done with XIOS.'
+       CALL xios_orchidee_set_file_attr("soils_param_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_fieldgroup_attr("soil_text",enabled=.FALSE.)
+    END IF
+    
+
+    !! 2. Prepare for reading of PFTmap file
+    filename = 'PFTmap.nc'
+    CALL getin_p('VEGETATION_FILE',filename)
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    CALL xios_orchidee_set_file_attr("PFTmap_file",name=name)
+
+    ! Get veget_update from run.def needed to know if the file needs to be read
+    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
+
+
+    ! Check if PFTmap file will be read by XIOS in this execution
+    IF ( xios_interpolation .AND. .NOT. impveg .AND. &
+         (veget_update>0 .OR. restname_in=='NONE')) THEN
+       ! PFTmap will not be read if impveg=TRUE
+       ! PFTmap file will be read each year if veget_update>0 
+       ! PFTmap is read if the restart file do not exist and if impveg=F
+
+       ! Reading will be done
+       IF (printlev>=2) WRITE(numout,*) 'Reading of PFTmap file will be done later using XIOS. The filename is ', filename
+    ELSE
+       ! No reading, deactivate PFTmap file
+       IF (printlev>=2) WRITE(numout,*) 'Reading of PFTmap file will not be done with XIOS.'
+       
+       CALL xios_orchidee_set_file_attr("PFTmap_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("frac_veget",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("frac_veget_frac",enabled=.FALSE.)
+    ENDIF
+    
+
+    !! 3. Prepare for reading of topography file
+    filename = 'cartepente2d_15min.nc'
+    CALL getin_p('TOPOGRAPHY_FILE',filename)
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    CALL xios_orchidee_set_file_attr("topography_file",name=name)
+    
+    ! Set default values used by XIOS for the interpolation
+    slope_noreinf = 0.5
+    CALL getin_p('SLOPE_NOREINF',slope_noreinf)
+    lerr=xios_orchidee_setvar('slope_noreinf',slope_noreinf)
+    lerr=xios_orchidee_setvar('slope_default',slope_default)
+    
+    get_slope = .FALSE.
+    CALL getin_p('GET_SLOPE',get_slope)
+    IF (xios_interpolation .AND. (restname_in=='NONE' .OR. get_slope)) THEN
+       ! The slope file will be read using XIOS
+       IF (printlev>=2) WRITE(numout,*) 'Reading of albedo file will be done later using XIOS. The filename is ', filename
+    ELSE
+       ! Deactivate slope reading
+       IF (printlev>=2) WRITE(numout,*) 'The slope file will not be read by XIOS'
+       CALL xios_orchidee_set_file_attr("topography_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("frac_slope_interp",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("reinf_slope_interp",enabled=.FALSE.)
+    END IF
+     
+    !! 4. Prepare for reading of lai file
+    filename = 'lai2D.nc'
+    CALL getin_p('LAI_FILE',filename)
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    CALL xios_orchidee_set_file_attr("lai_file",name=name)
+    ! Determine if lai file will be read. If not, deactivate the file.    
+    IF (xios_interpolation .AND. restname_in=='NONE' .AND. read_lai) THEN
+       ! Reading will be done
+       IF (printlev>=2) WRITE(numout,*) 'Reading of lai file will be done later using XIOS. The filename is ', filename
+    ELSE
+       ! No reading, deactivate lai file
+       IF (printlev>=2) WRITE(numout,*) 'Reading of lai file will not be done with XIOS.'
+       CALL xios_orchidee_set_file_attr("lai_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("frac_lai_interp",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("lai_interp",enabled=.FALSE.)
+    END IF
+    
+    !! 5. Prepare for reading of woodharvest file
+    filename = 'woodharvest.nc'
+    CALL getin_p('WOODHARVEST_FILE',filename)
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    CALL xios_orchidee_set_file_attr("woodharvest_file",name=name)
+    
+    IF (xios_interpolation .AND. do_wood_harvest .AND. &
+         (veget_update>0 .OR. restname_in=='NONE' )) THEN
+       ! Woodharvest file will be read each year if veget_update>0 or if no restart file exists
+
+       ! Reading will be done
+       IF (printlev>=2) WRITE(numout,*) 'Reading of woodharvest file will be done later using XIOS. The filename is ', filename
+    ELSE
+       ! No reading, deactivate woodharvest file
+       IF (printlev>=2) WRITE(numout,*) 'Reading of woodharvest file will not be done with XIOS.'
+       CALL xios_orchidee_set_file_attr("woodharvest_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("woodharvest_interp",enabled=.FALSE.)
+    ENDIF
+
+    IF (printlev_loc>=3) WRITE(numout,*) 'End slowproc_xios_intialize'
+   
+  END SUBROUTINE slowproc_xios_initialize
+
+
+!! ================================================================================================================================
+!! 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,     temp_air,                          &
+                                  soiltile,      reinf_slope,  deadleaf_cover, assim_param,       &
+                                  lai, &
+!!xchen                                                                         
+                                  lai_cl1,       lai_cl2,      lai_cl3,        lai_cl4,           &
+                                  laitop,        laidow,       VPD,            ave_VPD,           &
+                                  vcmax_cl1,     vcmax_cl2,    vcmax_cl3,      vcmax_cl4,         & 
+!! liuly above
+                                  frac_age,     height,         veget,             &
+                                  frac_nobio,    njsc,         veget_max,      fraclut,           &
+                                  nwdfraclut,    tot_bare_soil,totfrac_nobio,  qsintmax,          &
+                                  co2_flux,      co2_to_bm,    fco2_lu,      temp_growth)
+
+!! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                          :: kjit                !! Time step number
+    INTEGER(i_std), INTENT(in)                          :: kjpij               !! Total size of the un-compressed grid
+    INTEGER(i_std),INTENT(in)                           :: kjpindex            !! Domain size - terrestrial pixels only
+    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)        :: temp_air            !! Air temperature at first atmospheric model layer (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,nvm), INTENT(out)     :: co2_to_bm      !! Virtual gpp per average ground area (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: fco2_lu        !! CO2 flux from land-use (without forest management) (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: temp_growth    !! Growth temperature (Â°C) - Is equal to t2m_month 
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(out)       :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai            !! Leaf area index (m^2 m^{-2})
+
+!! liuly
+!!xchen
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai_cl1            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai_cl2            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai_cl3            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai_cl4            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)    :: laitop               !!xchen Wu (science, 2016) sunlit leaf area index @tex ($m^2 m^{-2}$) 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)    :: laidow               !!xchen Wu (science 2016) shade leaf area
+
+!! xchen add vpd for gpp simulation in Amazon                                   
+    REAL(r_std), DIMENSION(kjpindex),     INTENT (in)       :: VPD              !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(kjpindex),     INTENT (in)       :: ave_VPD              !! Vapor Pressure Deficit (kPa)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: vcmax_cl1            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: vcmax_cl2            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: vcmax_cl3            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: vcmax_cl4            !! Leaf area index (m^2 m^{-2})
+!! liuly above
+
+    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)         :: tot_bare_soil  !! Total evaporating bare soil fraction 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 within vegtot (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out)    :: fraclut        !! Fraction of each landuse tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out)    :: nwdFraclut     !! Fraction of non-woody vegetation in each landuse tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: reinf_slope    !! slope coef for reinfiltration
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (out):: assim_param    !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: qsintmax       !! Maximum water storage on vegetation from interception (mm)
+
+!! 0.3 Local variables
+    INTEGER(i_std)                                     :: jsl
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_frac         !! To ouput the clay/sand/silt fractions with a vertical dim
+
+!_ ================================================================================================================================
+
+    !! 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, lai, &
+  !!xchen                                                                         
+         lai_cl1, lai_cl2, lai_cl3, lai_cl4, &
+         laitop, laidow, VPD, ave_VPD, & 
+         vcmax_cl1, vcmax_cl2, vcmax_cl3, vcmax_cl4, & 
+   !! liuly above
+         frac_age, veget, frac_nobio, totfrac_nobio, soiltile, fraclut, nwdfraclut, reinf_slope, &
+         veget_max, tot_bare_soil, njsc, &
+         height, lcanop, veget_update, veget_year)
+    
+
+    !! 2. Define Time step in days for stomate
+    dt_days = dt_stomate / one_day
+    
+
+    !! 3. check time step coherence between slow processes and fast processes
+    IF ( dt_stomate .LT. dt_sechiba ) THEN
+       WRITE(numout,*) 'slow_processes: time step smaller than forcing time step, dt_sechiba=',dt_sechiba,' dt_stomate=',dt_stomate
+       CALL ipslerr_p(3,'slowproc_initialize','Coherence problem between dt_stomate and dt_sechiba',&
+            'Time step smaller than forcing time step','')
+    ENDIF
+    
+    !! 4. Call stomate to initialize all variables manadged in stomate,
+    IF ( ok_stomate ) THEN
+
+       CALL stomate_initialize &
+            (kjit,           kjpij,                  kjpindex,                        &
+             rest_id_stom,   hist_id_stom,           hist_id_stom_IPCC,               &
+             indexLand,      lalo,                   neighbours,   resolution,        &
+             contfrac,       totfrac_nobio,          clayfraction, temp_air,          &
+             lai,            veget,                  veget_max,                       &
+             co2_flux,       co2_to_bm,              fco2_lu,                         &
+             deadleaf_cover, assim_param,            temp_growth )
+    ENDIF
+    
+    !! 5. Specific run without the carbon cycle (STOMATE not called): 
+    !!     Need to initialize some variables that will be used in SECHIBA:
+    !!     height, deadleaf_cover, assim_param, qsintmax.
+    IF (.NOT. ok_stomate ) THEN
+       CALL slowproc_derivvar (kjpindex, veget, lai, &
+            qsintmax, deadleaf_cover, assim_param, height, temp_growth)
+    ELSE
+       qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+       qsintmax(:,1) = zero
+    ENDIF
+
+
+    !! 6. Output with XIOS for variables done only once per run
+
+    DO jsl=1,nslm
+       land_frac(:,jsl) = clayfraction(:)
+    ENDDO
+    CALL xios_orchidee_send_field("clayfraction",land_frac) ! mean fraction of clay in grid-cell
+    DO jsl=1,nslm
+       land_frac(:,jsl) = sandfraction(:)
+    ENDDO
+    CALL xios_orchidee_send_field("sandfraction",land_frac) ! mean fraction of sand in grid-cell
+    DO jsl=1,nslm
+       land_frac(:,jsl) = siltfraction(:)
+    ENDDO
+    CALL xios_orchidee_send_field("siltfraction",land_frac) ! mean fraction of silt in grid-cell
+    
+  END SUBROUTINE slowproc_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_main
+!!
+!>\BRIEF         Main routine that manage variable initialisation (slowproc_init), 
+!! prepare the restart file with the slowproc variables, update the time variables 
+!! for slow processes, and possibly update the vegetation cover, before calling 
+!! STOMATE in the case of the carbon cycle activated or just update LAI (and possibly
+!! the vegetation cover) for simulation with only SECHIBA   
+!!
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): The subroutine manages 
+!! diverses tasks:
+!! (1) Initializing all variables of slowproc (first call)
+!! (2) Preparation of the restart file for the next simulation with all prognostic variables
+!! (3) Compute and update time variable for slow processes
+!! (4) Update the vegetation cover if there is some land use change (only every years)
+!! (5) Call STOMATE for the runs with the carbone cycle activated (ok_stomate) and compute the respiration
+!!     and the net primary production
+!! (6) Compute the LAI and possibly update the vegetation cover for run without STOMATE 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::co2_flux, ::fco2_lu, ::lai, ::height, ::veget, ::frac_nobio,  
+!! ::veget_max, ::woodharvest, ::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, fraclut, nwdFraclut, &
+       temp_air, temp_sol, stempdiag, &
+       humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+       deadleaf_cover, &
+       assim_param, &
+       lai, &
+!!@xchen add lai_cl1-4 of leaf qge class 1-4
+       lai_cl1, lai_cl2, lai_cl3, lai_cl4,&
+       laitop, laidow, VPD, ave_VPD, &
+       vcmax_cl1, vcmax_cl2, vcmax_cl3, vcmax_cl4,&      
+!! liuly above       
+       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, co2_to_bm, temp_growth, tot_bare_soil,&
+       swdown)!!liulyc liulyw xuhui's crop but xchen used it.
+  
+!! 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
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution          !! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: contfrac            !! Fraction of continent in the grid (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)  :: humrel              !! Relative humidity ("moisture stress") (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: temp_air            !! Temperature of first model layer (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_sol            !! Surface temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)  :: stempdiag           !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nslm), 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,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   
+    !! liulyc liulyw xuhui's crop but xchen used it
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: swdown              !!downward shortwave radiation
+    
+!! 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,nvm), INTENT(out)  :: co2_to_bm           !! virtual gpp flux per average ground area (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: fco2_lu             !! CO2 flux from land-use (without forest management) (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: temp_growth         !! Growth temperature (Â°C) - Is equal to t2m_month 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: tot_bare_soil       !! Total evaporating bare soil fraction in the mesh
+    
+!! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: lai            !! Leaf area index (m^2 m^{-2})
+!! liuly
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai_cl1       !!@xchen Leaf area index of leaf age class 1 (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai_cl2       !!@xchen Leaf area index of leaf age class 2 (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai_cl3       !!@xchen Leaf area index of leaf age class 3 (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai_cl4       !!@xchen Leaf area index of leaf age class 4 (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)      :: laitop        !!xchen Wu (science, 2016) sunlit leaf area index @tex ($m^2 m^{-2}$) 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)      :: laidow        !!xchen Wu (science 2016) shade leaf area index @tex ($m^2 m^{-2}$) 
+!! xchen add vpd for gpp simulation in Amazon                                   
+    REAL(r_std), DIMENSION(kjpindex),     INTENT (in)      :: VPD           !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(kjpindex),     INTENT (inout)   :: ave_VPD       !! Vapor Pressure Deficit (kPa)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: vcmax_cl1     !!@xchen Leaf area index of leaf age class 1 (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: vcmax_cl2     !!@xchen Leaf area index of leaf age class 2 (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: vcmax_cl3     !!@xchen Leaf area index of leaf age class 3 (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: vcmax_cl4     !!@xchen Leaf area index of leaf age class 4 (m^2 m^{-2}
+!! liuly above
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: height         !! height of vegetation (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(inout):: frac_age   !! Age efficacity from STOMATE for isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: veget          !! Fraction of vegetation type including none biological fractionin the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout)  :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: veget_max      !! Maximum fraction of vegetation type in the mesh (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: totfrac_nobio  !! Total fraction of ice+lakes+cities etc. in the mesh
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout)    :: soiltile       !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(inout)    :: fraclut        !! Fraction of each landuse tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(inout)    :: nwdFraclut     !! Fraction of non-woody vegetation in each landuse tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (inout):: assim_param    !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: qsintmax       !! Maximum water storage on vegetation from interception (mm)
+
+!! 0.4 Local variables
+    INTEGER(i_std)                                     :: j, jv, ji            !! indices 
+    REAL(r_std), 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)                   :: totfrac_nobio_new    !! Total fraction for the next year 
+    REAL(r_std),DIMENSION (kjpindex)                   :: histvar              !! Temporary variable for output
+
+!_ ================================================================================================================================
+
+    !! 1. Compute and update all variables linked to the date and time
+    IF (printlev_loc>=5) WRITE(numout,*) 'Entering slowproc_main, year_start, month_start, day_start, sec_start=',&
+         year_start, month_start,day_start,sec_start   
+ 
+    !! 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 
+       days_since_beg = days_since_beg + 1
+       IF (printlev_loc>=4) WRITE(numout,*) "New days_since_beg : ",days_since_beg
+    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 ( FirstTsYear ) THEN
+       IF (veget_update > 0) THEN
+          veget_year = veget_year + 1
+   
+          ! Update of the vegetation cover with Land Use only if 
+          ! the current year match the requested condition (a multiple of "veget_update")
+          IF ( MOD(veget_year - veget_year_orig, veget_update) == 0 ) THEN
+             IF (printlev_loc>=1) WRITE(numout,*)  'We are updating the vegetation map for year =' , veget_year
+             
+             ! Read the new the vegetation from file. Output is veget_max_new and frac_nobio_new
+             CALL slowproc_readvegetmax(kjpindex, lalo, neighbours, resolution, contfrac, &
+                  veget_max, veget_max_new, frac_nobio_new, veget_year, .FALSE.)
+             
+             IF (do_wood_harvest) THEN
+                ! Read the new the wood harvest map from file. Output is wood harvest
+                CALL slowproc_woodharvest(kjpindex, lalo, neighbours, resolution, contfrac, woodharvest)
+             ENDIF
+   
+             ! 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
+       IF ( do_wood_harvest) THEN
+          ! Set the flag do_now_stomate_woodharvest to activate stomate_woodharvest.
+          ! This flag will be kept to true until stomate_woodharvest has been done. 
+          do_now_stomate_woodharvest=.TRUE.
+       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, &
+            temp_air, temp_sol, stempdiag, &
+            humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+            deadleaf_cover, &
+            assim_param, &
+            lai, &
+   !!xchen add lai_cl1-4 of leaf age class 1-4 for calculating PC in Wu paper
+            lai_cl1, lai_cl2, lai_cl3, lai_cl4,&
+            laitop, laidow, VPD, ave_VPD, &
+            vcmax_cl1, vcmax_cl2,vcmax_cl3,vcmax_cl4,& 
+   !! liuly above
+            frac_age, height, veget, veget_max, &
+            veget_max_new, woodharvest, totfrac_nobio_new, fraclut, &
+            rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+            co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth,co2_to_bm,temp_growth,&
+            & swdown) !!liulyc liulyw xuhui's crop but xchen used it
+
+       !! 4.2 Output the respiration terms and the net primary
+       !!     production (NPP) that are calculated in STOMATE
+
+       ! 4.2.1 Output the 3 respiration terms
+       ! These variables could be output from stomate.
+       ! Variables per pft
+       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)
+
+       ! Variables on grid-cell
+       CALL xios_orchidee_send_field("rh_ipcc2",SUM(resp_hetero,dim=2)/dt_sechiba)
+       histvar(:)=zero
+       DO jv = 2, nvm
+          IF ( .NOT. is_tree(jv) .AND. natural(jv) ) THEN
+             histvar(:) = histvar(:) + resp_hetero(:,jv)
+          ENDIF
+       ENDDO
+       CALL xios_orchidee_send_field("rhGrass",histvar/dt_sechiba)
+
+       histvar(:)=zero
+       DO jv = 2, nvm
+          IF ( (.NOT. is_tree(jv)) .AND. (.NOT. natural(jv)) ) THEN
+             histvar(:) = histvar(:) + resp_hetero(:,jv)
+          ENDIF
+       ENDDO
+       CALL xios_orchidee_send_field("rhCrop",histvar/dt_sechiba)
+
+       histvar(:)=zero
+       DO jv = 2, nvm
+          IF ( is_tree(jv) ) THEN
+             histvar(:) = histvar(:) + resp_hetero(:,jv)
+          ENDIF
+       ENDDO
+       CALL xios_orchidee_send_field("rhTree",histvar/dt_sechiba)
+
+       ! Output with IOIPSL
+       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)
+       
+       ! 4.2.2 Compute the net primary production as the diff from
+       ! Gross primary productin and the growth and maintenance respirations
+       npp(:,1)=zero
+       DO j = 2,nvm
+          npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j)
+       ENDDO
+       
+       CALL xios_orchidee_send_field("npp",npp/dt_sechiba)
+       
+       CALL histwrite_p(hist_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
+       
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'hetero_resp', kjit, resp_hetero, 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
+       co2_to_bm(:,:) = zero
+    ENDIF
+
+ 
+    !! 5. Do daily processes if necessary
+    !!
+    IF ( do_slow ) THEN
+
+       !!  5.1 Calculate the LAI if STOMATE is not activated
+       IF ( .NOT. ok_stomate ) THEN
+          CALL slowproc_lai (kjpindex, lcanop,stempdiag, &
+               lalo,resolution,lai,laimap)
+          
+          frac_age(:,:,1) = un
+          frac_age(:,:,2) = zero
+          frac_age(:,:,3) = zero
+          frac_age(:,:,4) = zero
+       ENDIF
+
+       !! 5.2 Update veget
+       CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile, fraclut, nwdFraclut)
+
+       !! 5.3 updates qsintmax and other derived variables
+       IF ( .NOT. ok_stomate ) THEN
+          CALL slowproc_derivvar (kjpindex, veget, lai, &
+               qsintmax, deadleaf_cover, assim_param, height, temp_growth)
+       ELSE
+          qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+          qsintmax(:,1) = zero
+       ENDIF
+    END IF
+
+    !! 6. Calculate tot_bare_soil needed in hydrol, diffuco and condveg (fraction in the mesh)
+    tot_bare_soil(:) = veget_max(:,1)
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          tot_bare_soil(ji) = tot_bare_soil(ji) + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+    END DO
+    
+
+    !! 7. Do some basic tests on the surface fractions updated above, only if
+    !!    slowproc_veget has been done (do_slow). No change of the variables. 
+    IF (do_slow) THEN
+        CALL slowproc_checkveget(kjpindex, frac_nobio, veget_max, veget, tot_bare_soil, soiltile)
+    END IF  
+
+    !! 8. Write output fields
+    CALL xios_orchidee_send_field("tot_bare_soil",tot_bare_soil)
+    
+    IF ( .NOT. almaoutput) THEN
+       CALL histwrite_p(hist_id, 'tot_bare_soil', kjit, tot_bare_soil, kjpindex, IndexLand)
+    END IF
+
+
+    IF (printlev_loc>=3) WRITE (numout,*) ' slowproc_main done '
+
+  END SUBROUTINE slowproc_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: slowproc_finalize
+!!
+!>\BRIEF         Write to restart file variables for slowproc module and call finalization of stomate module
+!!
+!! DESCRIPTION : 
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_finalize (kjit,       kjpindex,  rest_id,  IndexLand,  &
+                                njsc,       lai,       height,   veget,      &
+                                frac_nobio, veget_max, reinf_slope,          &
+                                co2_to_bm,  assim_param, frac_age )
+
+!! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit           !! Time step number
+    INTEGER(i_std),INTENT(in)                            :: kjpindex       !! Domain size - terrestrial pixels only
+    INTEGER(i_std),INTENT (in)                           :: rest_id        !! Restart file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: IndexLand      !! Indices of the points on the land map
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(in)      :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: lai            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: height         !! height of vegetation (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget          !! Fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget_max      !! Maximum fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)         :: reinf_slope    !! slope coef for reinfiltration
+    REAL(r_std),DIMENSION (kjpindex,nvm),INTENT(in)      :: co2_to_bm      !! virtual gpp flux between atmosphere and biosphere
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (in):: assim_param   !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(in):: frac_age  !! Age efficacity from STOMATE for isoprene
+!! 0.4 Local variables
+    REAL(r_std)                                          :: tmp_day(1)     !! temporary variable for I/O
+    INTEGER                                              :: jf             !! Indice
+    CHARACTER(LEN=4)                                     :: laistring      !! Temporary character string
+    CHARACTER(LEN=80)                                    :: var_name       !! To store variables names for I/O
+!_ ================================================================================================================================
+
+    IF (printlev_loc>=3) WRITE (numout,*) 'Write restart file with SLOWPROC variables '
+
+    ! 2.1 Write a series of variables controled by slowproc: day
+    ! counter, vegetation fraction, max vegetation fraction, LAI
+    ! variable from stomate, fraction of bare soil, soiltype
+    ! fraction, clay fraction, height of vegetation, map of LAI
+    
+    CALL restput_p (rest_id, 'veget', nbp_glo, nvm, 1, kjit, veget, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'veget_max', nbp_glo, nvm, 1, kjit, veget_max, 'scatter',  nbp_glo, index_g)
+
+    IF (do_wood_harvest) THEN
+       CALL restput_p (rest_id, 'woodharvest', nbp_glo, 1, 1, kjit, woodharvest, 'scatter',  nbp_glo, index_g)
+    END IF
+
+    CALL restput_p (rest_id, 'lai', nbp_glo, nvm, 1, kjit, lai, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'frac_nobio', nbp_glo, nnobio, 1, kjit, frac_nobio, 'scatter',  nbp_glo, index_g)
+
+
+    DO jf = 1, nleafages
+       ! variable name is somewhat complicated as ioipsl does not allow 3d variables for the moment...
+       WRITE(laistring,'(i4)') jf
+       laistring=ADJUSTL(laistring)
+       var_name='frac_age_'//laistring(1:LEN_TRIM(laistring))
+       CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, frac_age(:,:,jf), 'scatter',  nbp_glo, index_g)
+    ENDDO
+
+    ! 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, '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)
+    CALL restput_p (rest_id, 'sand_frac', nbp_glo, 1, 1, kjit, sandfraction, 'scatter',  nbp_glo, index_g)
+    !
+    ! The height of the vegetation could in principle be recalculated at the beginning of the run.
+    ! However, this is very tedious, as many special cases have to be taken into account. This variable
+    ! is therefore saved in the restart file.
+    CALL restput_p (rest_id, 'height', nbp_glo, nvm, 1, kjit, height, 'scatter',  nbp_glo, index_g)
+    !
+    ! Specific case where the LAI is read and not calculated by STOMATE: need to be saved
+    IF (read_lai) THEN     
+       CALL restput_p (rest_id, 'laimap', nbp_glo, nvm, 12, kjit, laimap)
+    ENDIF
+    !
+    ! 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)
+        
+    ! 2.2 Write restart variables managed by STOMATE
+    IF ( ok_stomate ) THEN
+       CALL stomate_finalize (kjit, kjpindex, indexLand, clayfraction, co2_to_bm, assim_param) 
+    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): ::lcanop, ::veget_update, ::veget_year,
+!! ::lai, ::veget, ::frac_nobio, ::totfrac_nobio, ::veget_max, ::height, ::soiltype
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_init (kjit, kjpindex, IndexLand, lalo, neighbours, resolution, contfrac, &
+       rest_id, lai, &
+   !!xchen
+       lai_cl1, lai_cl2, lai_cl3, lai_cl4, &
+       laitop, laidow, VPD, ave_VPD, &
+       vcmax_cl1, vcmax_cl2, vcmax_cl3, vcmax_cl4, & 
+   !! liuly above      
+       frac_age, veget, frac_nobio, totfrac_nobio, soiltile, fraclut, nwdfraclut, reinf_slope, &
+       veget_max, tot_bare_soil, njsc, &
+       height, lcanop, veget_update, veget_year)
+    
+    !! INTERFACE DESCRIPTION
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT (in)                           :: kjit           !! Time step number
+    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 ???)
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: lai            !! Leaf Area index (m^2 / m^2)
+
+!! liuly
+!!@xchen
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: lai_cl1            !! Leaf Area index (m^2 / m^2)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: lai_cl2            !! Leaf Area index (m^2 / m^2)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: lai_cl3            !! Leaf Area index (m^2 / m^2)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: lai_cl4            !! Leaf Area index (m^2 / m^2)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)   :: laitop             !!xchen Wu (science, 2016) sunlit leaf area index @tex ($m^2 m^{-2}$) 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)   :: laidow             !!xchen Wu (science 2016) shade leaf area index @tex ($m^2 m^{-2}$) 
+!! xchen add vpd for gpp simulation in Amazon                                   
+    REAL(r_std), DIMENSION(kjpindex),     INTENT (in)       :: VPD              !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(kjpindex),     INTENT (in)       :: ave_VPD              !! Vapor Pressure Deficit (kPa)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: vcmax_cl1            !! Leaf Area index (m^2 / m^2)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: vcmax_cl2            !! Leaf Area index (m^2 / m^2)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: vcmax_cl3            !! Leaf Area index (m^2 / m^2)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: vcmax_cl4            !! Leaf Area index (m^2 / m^2)
+!! liuly above
+
+    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), INTENT (out)        :: tot_bare_soil  !! Total evaporating bare soil fraction in the mesh
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: height         !! Height of vegetation or surface in genral ??? (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT (out):: frac_age !! Age efficacity from STOMATE for isoprene
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)   :: soiltile       !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out)   :: fraclut        !! Fraction of each landuse tile
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out)   :: nwdfraclut     !! Fraction of non woody vegetation in each landuse tile
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)        :: reinf_slope    !! slope coef for reinfiltration
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(out)      :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    
+    !! 0.3 Local variables 
+    REAL(r_std)                                           :: tmp_veget_year(1) !! temporary variable
+    REAL(r_std)                                           :: zcanop            !! ???? soil depth taken for canopy
+    INTEGER(i_std)                                        :: vtmp(1)           !! temporary variable
+    REAL(r_std), DIMENSION(nslm)                          :: zsoil             !! soil depths at diagnostic levels
+    CHARACTER(LEN=4)                                      :: laistring         !! Temporary character string
+    INTEGER(i_std)                                        :: l, jf             !! Indices
+    CHARACTER(LEN=80)                                     :: var_name          !! To store variables names for I/O
+    INTEGER(i_std)                                        :: ji, jv, ier,jst   !! Indices 
+    LOGICAL                                               :: get_slope
+    REAL(r_std)                                           :: frac_nobio1       !! temporary variable for frac_nobio(see above)
+    REAL(r_std), DIMENSION(kjpindex)                      :: tmp_real
+    REAL(r_std), DIMENSION(kjpindex,nslm)                 :: 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)
+    REAL(r_std), DIMENSION(kjpindex)                      :: frac_crop_tot     !! Total fraction occupied by crops (0-1, unitless)
+    LOGICAL                                               :: found_restart     !! found_restart=true if all 3 variables veget_max, veget and 
+                                                                               !! frac_nobio are read from restart file
+    !_ ================================================================================================================================
+  
+    !! 0. Initialize local printlev
+    printlev_loc=get_printlev('slowproc')
+    IF (printlev_loc>=3) WRITE (numout,*) "In slowproc_init"
+    
+    
+    !! 1. Allocation 
+
+    ALLOCATE (clayfraction(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable clayfraction','','')
+    clayfraction(:)=undef_sechiba
+    
+    ALLOCATE (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 /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable siltfraction','','')
+    siltfraction(:)=undef_sechiba
+
+    ! Initialisation of the fraction of the different vegetation: Start with 100% of bare soil
+    ALLOCATE (soilclass_default(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable soilclass_default','','')
+    soilclass_default(:)=undef_sechiba
+
+    ! Allocation of last year vegetation fraction in case of land use change
+    ALLOCATE(veget_max_new(kjpindex, nvm), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable veget_max_new','','')
+
+    ! Allocation of wood harvest
+    ALLOCATE(woodharvest(kjpindex), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable woodharvest','','')
+
+    ! Allocation of the fraction of non biospheric areas 
+    ALLOCATE(frac_nobio_new(kjpindex, nnobio), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable frac_nobio_new','','')
+    
+    ! Allocate laimap
+    IF (read_lai)THEN
+       ALLOCATE (laimap(kjpindex,nvm,12),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable laimap','','')
+    ELSE
+       ALLOCATE (laimap(1,1,1), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable laimap(1,1,1)','','')
+    ENDIF
+
+
+    !! 2. Read variables from restart file
+
+    found_restart=.TRUE.
+    var_name= 'veget'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Vegetation fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., veget, "gather", nbp_glo, index_g)
+    IF ( ALL( veget(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    var_name= 'veget_max'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Maximum vegetation fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., veget_max, "gather", nbp_glo, index_g)
+    IF ( ALL( veget_max(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    IF (do_wood_harvest) THEN
+       var_name= 'woodharvest'
+       CALL ioconf_setatt_p('UNITS', 'gC m-2 yr-1')
+       CALL ioconf_setatt_p('LONG_NAME','Harvest wood biomass')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., woodharvest, "gather", nbp_glo, index_g)
+       IF ( ALL( woodharvest(:) .EQ. val_exp ) ) woodharvest(:)=zero
+    END IF
+
+    var_name= 'frac_nobio'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Special soil type fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nnobio, 1, kjit, .TRUE., frac_nobio, "gather", nbp_glo, index_g)
+    IF ( ALL( frac_nobio(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    IF (.NOT. impveg) THEN
+       var_name= 'veget_year'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Last year get in Land Use file.')
+       IF (is_root_prc) THEN
+          CALL restget (rest_id, var_name, 1       , 1  , 1, kjit, .TRUE., tmp_veget_year)
+          IF (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)
+
+       !
+       !Config Key   = VEGET_UPDATE
+       !Config Desc  = Update vegetation frequency: 0Y or 1Y
+       !Config If    = 
+       !Config Def   = 0Y
+       !Config Help  = The veget datas will be update each this time step. Must be 0Y if IMPOSE_VEG=y.
+       !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
+       IF (printlev_loc >= 2) WRITE(numout,*) "Update frequency for land use in years :",veget_update
+
+       ! Coherence test
+       IF (veget_update > 0 .AND. ok_dgvm .AND. .NOT. agriculture) THEN
+          CALL ipslerr_p(3,'slowproc_init',&
+               'The combination DGVM=TRUE, AGRICULTURE=FALSE and VEGET_UPDATE>0 is not possible', &
+               'Set VEGET_UPDATE=0Y in run.def','')
+       END IF
+    ELSE
+       ! 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
+       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
+       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 0Y if IMPOSE_VEG=y (impveg=true)','')
+       END IF
+
+    ENDIF
+
+    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)
+    
+    
+    ! Below we define the soil texture of the grid-cells
+    ! 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'
+    ELSE
+       CALL ipslerr_p(3,'slowproc_init','Non supported soil type classification','','')
+    END IF
+
+    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= 'sand_frac'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of sand in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., sandfraction, "gather", nbp_glo, index_g)	
+
+    ! Calculate siltfraction not needed to be in restart file
+    IF ( ALL( sandfraction(:) .EQ. val_exp) ) THEN
+       siltfraction(:) = val_exp
+    ELSE
+       siltfraction(:) = 1. - clayfraction(:) - sandfraction(:)
+    END IF
+
+    var_name= 'lai'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Leaf area index')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., lai, "gather", nbp_glo, index_g)
+
+    !! liuly xchen yuechao
+    !@chy
+    !!if you need to put lai_cl1 into restart file, I think it needs to be done here
+    !!the same as lai
+    var_name= 'lai_cl1'                                                             
+    CALL ioconf_setatt_p('UNITS', '-')                                          
+    CALL ioconf_setatt_p('LONG_NAME','Leaf area index of leaf age class 1')                         
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., lai_cl1, "gather", nbp_glo, index_g)
+    var_name= 'lai_cl2'                                                         
+    CALL ioconf_setatt_p('UNITS', '-')                                          
+    CALL ioconf_setatt_p('LONG_NAME','Leaf area index of leaf age class 2')     
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., lai_cl2, "gather", nbp_glo, index_g)
+    var_name= 'lai_cl3'                                                         
+    CALL ioconf_setatt_p('UNITS', '-')                                          
+    CALL ioconf_setatt_p('LONG_NAME','Leaf area index of leaf age class 3')     
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., lai_cl3, "gather", nbp_glo, index_g)
+    var_name= 'lai_cl4'                                                         
+    CALL ioconf_setatt_p('UNITS', '-')                                          
+    CALL ioconf_setatt_p('LONG_NAME','Leaf area index of leaf age class 4')     
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., lai_cl4, "gather", nbp_glo, index_g)
+    var_name= 'vcmax_cl1'                                                         
+    CALL ioconf_setatt_p('UNITS', '-')                                          
+    CALL ioconf_setatt_p('LONG_NAME','vcmax of leaf age class 1')     
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vcmax_cl1, "gather", nbp_glo, index_g)
+    var_name= 'vcmax_cl2'                                                       
+    CALL ioconf_setatt_p('UNITS', '-')                                          
+    CALL ioconf_setatt_p('LONG_NAME','vcmax of leaf age class 2')               
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vcmax_cl2, "gather", nbp_glo, index_g)
+    var_name= 'vcmax_cl3'                                                       
+    CALL ioconf_setatt_p('UNITS', '-')                                          
+    CALL ioconf_setatt_p('LONG_NAME','vcmax of leaf age class 3')               
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vcmax_cl3, "gather", nbp_glo, index_g)
+    var_name= 'vcmax_cl4'                                                       
+    CALL ioconf_setatt_p('UNITS', '-')                                          
+    CALL ioconf_setatt_p('LONG_NAME','vcmax of leaf age class 4')               
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vcmax_cl4, "gather", nbp_glo, index_g)
+
+
+    ! The height of the vegetation could in principle be recalculated at the beginning of the run.
+    ! However, this is very tedious, as many special cases have to be taken into account. This variable
+    ! is therefore saved in the restart file.
+    var_name= 'height'
+    CALL ioconf_setatt_p('UNITS', 'm')
+    CALL ioconf_setatt_p('LONG_NAME','Height of vegetation')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., height, "gather", nbp_glo, index_g)
+ 
+    IF (read_lai)THEN
+       var_name= 'laimap'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Leaf area index read')
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 12, kjit, .TRUE., laimap)
+    ENDIF
+
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of leaves in leaf age class ')
+    DO jf = 1, nleafages
+       ! variable name is somewhat complicated as ioipsl does not allow 3d variables for the moment...
+       WRITE(laistring,'(i4)') jf
+       laistring=ADJUSTL(laistring)
+       var_name='frac_age_'//laistring(1:LEN_TRIM(laistring))
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE.,frac_age(:,:,jf), "gather", nbp_glo, index_g)
+    ENDDO
+
+    !! 3. Some other initializations
+
+    !Config Key   = SECHIBA_ZCANOP
+    !Config Desc  = Soil level used for canopy development (if STOMATE disactivated)
+    !Config If    = OK_SECHIBA and .NOT. OK_STOMATE  
+    !Config Def   = 0.5
+    !Config Help  = The temperature at this soil depth is used to determine the LAI when
+    !Config         STOMATE is not activated.
+    !Config Units = [m]
+    zcanop = 0.5_r_std
+    CALL setvar_p (zcanop, val_exp, 'SECHIBA_ZCANOP', 0.5_r_std)
+
+    ! depth at center of the levels
+    zsoil(1) = diaglev(1) / 2.
+    DO l = 2, nslm
+       zsoil(l) = ( diaglev(l) + diaglev(l-1) ) / 2.
+    ENDDO
+
+    ! index of this level
+    vtmp = MINLOC ( ABS ( zcanop - zsoil(:) ) )
+    lcanop = vtmp(1)
+
+    !
+    !  Interception reservoir coefficient
+    !
+    !Config Key   = SECHIBA_QSINT 
+    !Config Desc  = Interception reservoir coefficient
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 0.1
+    !Config Help  = Transforms leaf area index into size of interception reservoir
+    !Config         for slowproc_derivvar or stomate
+    !Config Units = [m]
+    CALL getin_p('SECHIBA_QSINT', qsintcst)
+    IF (printlev >= 2) WRITE(numout, *)' SECHIBA_QSINT, qsintcst = ', qsintcst
+
+
+
+
+    !! 4. Initialization of variables not found in restart file
+
+    IF ( impveg ) THEN
+
+       !! 4.1.a Case impveg=true: Initialization of variables by reading run.def
+       !!       The routine setvar_p will only initialize the variable if it was not found in restart file. 
+       !!       We are on a point and thus we can read the information from the run.def
+       
+       !Config Key   = SECHIBA_VEGMAX
+       !Config Desc  = Maximum vegetation distribution within the mesh (0-dim mode)
+       !Config If    = IMPOSE_VEG
+       !Config Def   = 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0
+       !Config Help  = The fraction of vegetation is read from the restart file. If
+       !Config         it is not found there we will use the values provided here.
+       !Config Units = [-]
+       CALL setvar_p (veget_max, val_exp, 'SECHIBA_VEGMAX', veget_ori_fixed_test_1)
+
+       !Config Key   = SECHIBA_FRAC_NOBIO
+       !Config Desc  = Fraction of other surface types within the mesh (0-dim mode)
+       !Config If    = IMPOSE_VEG
+       !Config Def   = 0.0
+       !Config Help  = The fraction of ice, lakes, etc. is read from the restart file. If
+       !Config         it is not found there we will use the values provided here.
+       !Config         For the moment, there is only ice.
+       !Config Units = [-]
+       frac_nobio1 = frac_nobio(1,1)
+       CALL setvar_p (frac_nobio1, val_exp, 'SECHIBA_FRAC_NOBIO', frac_nobio_fixed_test_1)
+       frac_nobio(:,:) = frac_nobio1
+
+       IF (.NOT. found_restart) THEN
+          ! Call slowproc_veget to correct veget_max and to calculate veget and soiltiles
+          CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile, fraclut, nwdFraclut)
+       END IF
+       
+       !Config Key   = SECHIBA_LAI
+       !Config Desc  = LAI for all vegetation types (0-dim mode)
+       !Config Def   = 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2.
+       !Config If    = IMPOSE_VEG
+       !Config Help  = The maximum LAI used in the 0dim mode. The values should be found
+       !Config         in the restart file. The new values of LAI will be computed anyway
+       !Config         at the end of the current day. The need for this variable is caused
+       !Config         by the fact that the model may stop during a day and thus we have not
+       !Config         yet been through the routines which compute the new surface conditions.
+       !Config Units = [-]
+       CALL setvar_p (lai, val_exp, 'SECHIBA_LAI', llaimax)
+
+       IF (impsoilt) THEN
+
+          ! If njsc is not in restart file, then initialize soilclass from values 
+          ! from run.def file and recalculate njsc
+          IF ( ALL(njsc(:) .EQ. undef_int )) THEN
+             !Config Key   = SOIL_FRACTIONS
+             !Config Desc  = Fraction of the 3 soil types (0-dim mode)
+             !Config Def   = undef_sechiba
+             !Config If    = IMPOSE_VEG and IMPOSE_SOILT
+             !Config Help  = Determines the fraction for the 3 soil types
+             !Config         in the mesh in the following order : sand loam and clay.
+             !Config Units = [-]
+          
+             soilclass(1,:) = soilclass_default(:)
+             CALL getin_p('SOIL_FRACTIONS',soilclass(1,:))
+             ! Assign for each grid-cell the % of the different textural classes (up to 12 if 'usda')
+             DO ji=2,kjpindex
+                ! here we read, for the prescribed grid-cell, the % occupied by each of the soil texture classes 
+                soilclass(ji,:) = soilclass(1,:)
+             ENDDO
+
+             ! Simplify an heterogeneous grid-cell into an homogeneous one with the dominant texture
+             njsc(:) = 0
+             DO ji = 1, kjpindex
+                ! here we reduce to the dominant texture class
+                njsc(ji) = MAXLOC(soilclass(ji,:),1)
+             ENDDO
+          END IF
+
+          !Config Key   = CLAY_FRACTION
+          !Config Desc  = Fraction of the clay fraction (0-dim mode)
+          !Config Def   = 0.2
+          !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+          !Config Help  = Determines the fraction of clay in the grid box.
+          !Config Units = [-] 
+          
+          ! If clayfraction was not in restart file it will be read fro run.def file instead of deduced 
+          ! based on fractions of each textural class
+          CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default)
+
+          !Config Key   = SAND_FRACTION
+          !Config Desc  = Fraction of the clay fraction (0-dim mode)
+          !Config Def   = 0.4
+          !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+          !Config Help  = Determines the fraction of clay in the grid box.
+          !Config Units = [-] 
+          
+          ! If sand fraction was not in restart file it will be read fro run.def file
+          CALL setvar_p (sandfraction, val_exp, 'SAND_FRACTION', sandfraction_default)
+
+          ! Calculate silt fraction
+          siltfraction(:) = 1. - clayfraction(:) - sandfraction(:)
+
+       ELSE ! impveg=T and impsoil=F
+          ! Case impsoilt=false and impveg=true
+          IF ( MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp .OR. &
+               MINVAL(sandfraction) .EQ. MAXVAL(sandfraction) .AND. MAXVAL(sandfraction) .EQ. val_exp .OR. &
+               MINVAL(njsc) .EQ. MAXVAL(njsc) .AND. MAXVAL(njsc) .EQ. undef_int ) THEN
+             
+             CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soilclass, &
+                  clayfraction, sandfraction, siltfraction)
+             njsc(:) = 0
+             DO ji = 1, kjpindex
+                njsc(ji) = MAXLOC(soilclass(ji,:),1)
+             ENDDO
+          ENDIF
+       ENDIF
+
+       !Config Key   = REINF_SLOPE
+       !Config Desc  = Slope coef for reinfiltration 
+       !Config Def   = 0.1
+       !Config If    = IMPOSE_VEG
+       !Config Help  = Determines the reinfiltration ratio in the grid box due to flat areas
+       !Config Units = [-]
+       !
+       slope_default=0.1
+       CALL setvar_p (reinf_slope, val_exp, 'SLOPE', slope_default)
+
+       !Config Key   = SLOWPROC_HEIGHT
+       !Config Desc  = Height for all vegetation types 
+       !Config Def   = 0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1.0, 1.0
+       !Config If    = OK_SECHIBA
+       !Config Help  = The height used in the 0dim mode. The values should be found
+       !Config         in the restart file. The new values of height will be computed anyway
+       !Config         at the end of the current day. The need for this variable is caused
+       !Config         by the fact that the model may stop during a day and thus we have not
+       !Config         yet been through the routines which compute the new surface conditions.
+       !Config Units = [m]
+       CALL setvar_p (height, val_exp, 'SLOWPROC_HEIGHT', height_presc)
+
+
+    ELSE IF ( .NOT. found_restart .OR. vegetmap_reset ) THEN
+ 
+       !! 4.1.b Case impveg=false and no restart files: Initialization by reading vegetation map
+       
+       ! Initialize veget_max and frac_nobio
+       ! Case without restart 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         
+       
+       IF (do_wood_harvest) THEN
+          ! Read the new the wood harvest map from file. Output is wood harvest
+          CALL slowproc_woodharvest(kjpindex, lalo, neighbours, resolution, contfrac, woodharvest)
+       ENDIF
+       
+       
+       !! Reset totaly or partialy veget_max if using DGVM
+       IF ( ok_dgvm  ) THEN
+          ! If we are dealing with dynamic vegetation then all natural PFTs should be set to veget_max = 0
+          ! In case no agriculture is desired, agriculture PFTS should be set to 0 as well
+          IF (agriculture) THEN
+             DO jv = 2, nvm
+                IF (natural(jv)) THEN 
+                   veget_max(:,jv)=zero
+                ENDIF
+             ENDDO
+             
+             ! Calculate the fraction of crop for each point.
+             ! Sum only on the indexes corresponding to the non_natural pfts
+             frac_crop_tot(:) = zero
+             DO jv = 2, nvm
+                IF(.NOT. natural(jv)) THEN
+                   DO ji = 1, kjpindex
+                      frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
+                   ENDDO
+                ENDIF
+             END DO
+            
+             ! Calculate the fraction of bare soil
+             DO ji = 1, kjpindex
+                veget_max(ji,1) = un - frac_crop_tot(ji) - SUM(frac_nobio(ji,:))   
+             ENDDO
+          ELSE
+             veget_max(:,:) = zero
+             DO ji = 1, kjpindex
+                veget_max(ji,1) = un  - SUM(frac_nobio(ji,:))
+             ENDDO
+          END IF
+       END IF   ! end ok_dgvm
+       
+
+       ! Call slowproc_veget to correct veget_max and to calculate veget and soiltiles
+       CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile, fraclut, nwdFraclut)
+       
+    END IF ! end impveg
+
+    !! 4.2 Continue initializing variables not found in restart file. Case for both impveg=true and false.
+
+    ! Initialize laimap for the case read_lai if not found in restart file
+    IF (read_lai) THEN
+       IF ( ALL( laimap(:,:,:) .EQ. val_exp) ) THEN
+          ! Interpolation of LAI
+          CALL slowproc_interlai (kjpindex, lalo, resolution,  neighbours, contfrac, laimap)
+       ENDIF
+    ENDIF
+    
+    ! Initialize lai if not found in restart file and not already initialized using impveg
+    IF ( MINVAL(lai) .EQ. MAXVAL(lai) .AND. MAXVAL(lai) .EQ. val_exp) THEN
+       IF (read_lai) THEN
+          stempdiag2_bid(1:kjpindex,1:nslm) = stempdiag_bid
+          CALL slowproc_lai (kjpindex, lcanop, stempdiag2_bid, &
+               lalo,resolution,lai,laimap)
+       ELSE
+          ! If we start from scratch, we set lai to zero for consistency with stomate
+          lai(:,:) = zero
+      
+!! liulyw copy from xchen code 
+      !!@chy if you have problem with lai_cl1 values in sechiba.f90, it can be due to
+      !!their values are not initialized here. And this is really the case, i.e., you
+      !!have problems for values of lai_cl1 in sechiba.f90, remember to take care 
+      !!other things: pass lai_cl1 as parameter etc.
+          lai_cl1(:,:) = zero
+          lai_cl2(:,:) = zero                                                   
+          lai_cl3(:,:) = zero                                                   
+          lai_cl4(:,:) = zero 
+       ENDIF
+       
+       frac_age(:,:,1) = un
+       frac_age(:,:,2) = zero
+       frac_age(:,:,3) = zero
+       frac_age(:,:,4) = zero
+    ENDIF
+    
+    ! Initialize heigth if not found in restart file and not already initialized using impveg
+    IF ( MINVAL(height) .EQ. MAXVAL(height) .AND. MAXVAL(height) .EQ. val_exp) THEN
+       ! Impose height
+       DO jv = 1, nvm
+          height(:,jv) = height_presc(jv)
+       ENDDO
+    ENDIF
+    
+    ! Initialize clayfraction and njsc if not found in restart file and not already initialized using impveg
+    IF ( MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp .OR. &
+         MINVAL(sandfraction) .EQ. MAXVAL(sandfraction) .AND. MAXVAL(sandfraction) .EQ. val_exp .OR. &
+         MINVAL(njsc) .EQ. MAXVAL(njsc) .AND. MAXVAL(njsc) .EQ. undef_int ) THEN
+       
+       IF (printlev_loc>=4) WRITE (numout,*) 'clayfraction or njcs were not in restart file, call slowproc_soilt'
+       CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soilclass, &
+            clayfraction, sandfraction, siltfraction)
+       IF (printlev_loc>=4) WRITE (numout,*) 'After slowproc_soilt'
+       njsc(:) = 0
+       DO ji = 1, kjpindex
+          njsc(ji) = MAXLOC(soilclass(ji,:),1)
+       ENDDO
+    ENDIF
+
+    !Config Key   = GET_SLOPE
+    !Config Desc  = Read slopes from file and do the interpolation
+    !Config Def   = n
+    !Config If    =
+    !Config Help  = Needed for reading the slopesfile and doing the interpolation. This will be
+    !               used by the re-infiltration parametrization
+    !Config Units = [FLAG]
+    get_slope = .FALSE.
+    CALL getin_p('GET_SLOPE',get_slope)
+    
+    IF ( MINVAL(reinf_slope) .EQ. MAXVAL(reinf_slope) .AND. MAXVAL(reinf_slope) .EQ. val_exp .OR. get_slope) THEN
+       IF (printlev_loc>=4) WRITE (numout,*) 'reinf_slope was not in restart file. Now call slowproc_slope'
+       
+       CALL slowproc_slope(kjpindex, lalo, neighbours, resolution, contfrac, reinf_slope)
+       IF (printlev_loc>=4) WRITE (numout,*) 'After slowproc_slope'
+       
+    ENDIF
+
+
+    
+    !! 5. Some calculations always done, with and without restart files
+       
+    ! The variables veget, veget_max and frac_nobio were all read from restart file or initialized above.
+    ! Calculate now totfrac_nobio and soiltiles using these variables.
+    
+    ! Calculate totfrac_nobio
+    totfrac_nobio(:) = zero
+    DO jv = 1, nnobio
+       totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,jv)
+    ENDDO
+    
+    ! Calculate soiltile. This variable do not need to be in the restart file.
+    ! 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
+    
+    ! Always calculate tot_bare_soil
+    ! Fraction of bare soil in the mesh (bio+nobio) 
+    tot_bare_soil(:) = veget_max(:,1)
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          tot_bare_soil(ji) = tot_bare_soil(ji) + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+    END DO
+    
+
+    !! Calculate fraction of landuse tiles to be used only for diagnostic variables
+    fraclut(:,:)=0
+    nwdFraclut(:,id_psl)=0
+    nwdFraclut(:,id_crp)=1.
+    nwdFraclut(:,id_urb)=xios_default_val
+    nwdFraclut(:,id_pst)=xios_default_val
+    DO jv=1,nvm
+       IF (natural(jv)) THEN
+          fraclut(:,id_psl) = fraclut(:,id_psl) + veget_max(:,jv)
+          IF(.NOT. is_tree(jv)) THEN
+             nwdFraclut(:,id_psl) = nwdFraclut(:,id_psl) + veget_max(:,jv) 
+          ENDIF
+       ELSE
+          fraclut(:,id_crp) = fraclut(:,id_crp) + veget_max(:,jv)
+       ENDIF
+    END DO
+    
+    WHERE (fraclut(:,id_psl) > min_sechiba)
+       nwdFraclut(:,id_psl) = nwdFraclut(:,id_psl)/fraclut(:,id_psl)
+    ELSEWHERE
+       nwdFraclut(:,id_psl) = xios_default_val
+    END WHERE    
+
+
+    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 (laimap)) DEALLOCATE (laimap)
+    IF (ALLOCATED (veget_max_new)) DEALLOCATE (veget_max_new)
+    IF (ALLOCATED (woodharvest)) DEALLOCATE (woodharvest)
+    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, ::assim_param, ::height  
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_derivvar (kjpindex, veget, lai, &
+       qsintmax, deadleaf_cover, assim_param, height, temp_growth)
+
+    !! INTERFACE DESCRIPTION
+
+    !! 0.1 Input scalar and fields 
+    INTEGER(i_std), INTENT (in)                                :: kjpindex       !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: veget          !! Fraction of pixel covered by PFT. Fraction accounts for none-biological land covers (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: lai            !! PFT leaf area index (m^{2} m^{-2})
+
+    !! 0.2. Output scalar and fields 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)          :: qsintmax       !! Maximum water on vegetation for interception(mm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)              :: deadleaf_cover !! fraction of soil covered by dead leaves (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm,npco2), INTENT (out)   :: assim_param    !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)          :: height         !! height of the vegetation or surface in general ??? (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)              :: temp_growth    !! growth temperature (Â°C)  
+    !
+    !! 0.3 Local declaration
+    INTEGER(i_std)                                              :: jv             !! Local indices
+!_ ================================================================================================================================
+
+    !
+    ! 1. Initialize (why here ??) the variables revelant for the assimilation parameters
+    !
+    DO jv = 1, nvm
+       assim_param(:,jv,ivcmax) = vcmax_fix(jv)
+    ENDDO
+
+    !
+    ! 2. Intialize the fraction of soil covered by dead leaves 
+    !
+    deadleaf_cover(:) = zero
+
+    !
+    ! 3. Initialize the Vegetation height per PFT
+    !
+    DO jv = 1, nvm
+       height(:,jv) = height_presc(jv)
+    ENDDO
+    !
+    ! 4. Initialize the maximum water on vegetation for interception
+    !
+    qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+
+    ! Added by Nathalie - July 2006
+    !  Initialize the case of the PFT no.1 to zero 
+    qsintmax(:,1) = zero
+
+    temp_growth(:)=25.
+
+  END SUBROUTINE slowproc_derivvar
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_mean
+!!
+!>\BRIEF          Accumulates field_in over a period of dt_tot.
+!! Has to be called at every time step (dt). 
+!! Mean value is calculated if ldmean=.TRUE.
+!! field_mean must be initialized outside of this routine! 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) AcumAcuumlm 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::field_main
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_mean (npts, n_dim2, dt_tot, dt, ldmean, field_in, field_mean)
+
+    !
+    !! 0 declarations
+
+    !! 0.1 input scalar and variables 
+    INTEGER(i_std), INTENT(in)                           :: npts     !! Domain size- terrestrial pixels only 
+    INTEGER(i_std), INTENT(in)                           :: n_dim2   !! Number of PFTs 
+    REAL(r_std), INTENT(in)                              :: dt_tot   !! Time step of stomate (in days). The period over which the accumulation or the mean is computed 
+    REAL(r_std), INTENT(in)                              :: dt       !! Time step in days 
+    LOGICAL, INTENT(in)                                  :: ldmean   !! Flag to calculate the mean after the accumulation ???
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(in)      :: field_in !! Daily field 
+
+    !! 0.3 Modified field; The computed sum or mean field over dt_tot time period depending on the flag ldmean 
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(inout)   :: field_mean !! Accumulated field at dt_tot time period or mean field over dt_tot 
+ 
+
+!_ ================================================================================================================================
+
+    !
+    ! 1. Accumulation the field over dt_tot period 
+    !
+    field_mean(:,:) = field_mean(:,:) + field_in(:,:) * dt
+
+    !
+    ! 2. If the flag ldmean set, the mean field is computed over dt_tot period  
+    !
+    IF (ldmean) THEN
+       field_mean(:,:) = field_mean(:,:) / dt_tot
+    ENDIF
+
+  END SUBROUTINE slowproc_mean
+
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_long
+!!
+!>\BRIEF        Calculates a temporally smoothed field (field_long) from
+!! instantaneous input fields.Time constant tau determines the strength of the smoothing.
+!! For tau -> infinity??, field_long becomes the true mean value of field_inst
+!! (but  the spinup becomes infinietly long, too).
+!! field_long must be initialized outside of this routine! 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) Testing the time coherence betwen the time step dt and the time tau over which
+!! the rescaled of the mean is performed   
+!!  (2) Computing the rescaled mean over tau period 
+!! MAIN OUTPUT VARIABLE(S): field_long  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::field_long
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_long (npts, n_dim2, dt, tau, field_inst, field_long)
+
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input scalar and fields 
+
+    INTEGER(i_std), INTENT(in)                                 :: npts        !! Domain size- terrestrial pixels only
+    INTEGER(i_std), INTENT(in)                                 :: n_dim2      !! Second dimension of the fields, which represents the number of PFTs
+    REAL(r_std), INTENT(in)                                    :: dt          !! Time step in days   
+    REAL(r_std), INTENT(in)                                    :: tau         !! Integration time constant (has to have same unit as dt!)  
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(in)            :: field_inst  !! Instantaneous field 
+
+
+    ! 0.2 modified field
+
+    ! Long-term field
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(inout)         :: field_long  !! Mean value of the instantaneous field rescaled at tau time period 
+
+!_ ================================================================================================================================
+
+    !
+    ! 1 test coherence of the time 
+
+    IF ( ( tau .LT. dt ) .OR. ( dt .LE. zero ) .OR. ( tau .LE. zero ) ) THEN
+       WRITE(numout,*) 'slowproc_long: Problem with time steps'
+       WRITE(numout,*) 'dt=',dt
+       WRITE(numout,*) 'tau=',tau
+    ENDIF
+
+    !
+    ! 2 integration of the field over tau 
+
+    field_long(:,:) = ( field_inst(:,:)*dt + field_long(:,:)*(tau-dt) ) / tau
+
+  END SUBROUTINE slowproc_long
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_veget
+!!
+!>\BRIEF        Set small fractions to zero and normalize to keep the sum equal 1. Calucate veget and soiltile.
+!!
+!! DESCRIPTION  : Set small fractions to zero and normalize to keep the sum equal 1. Calucate veget and soiltile.
+!! (1) Set veget_max and frac_nobio for fraction smaller than min_vegfrac.
+!! (2) Calculate veget
+!! (3) Calculate totfrac_nobio
+!! (4) Calculate soiltile
+!! (5) Calculate fraclut
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: frac_nobio, totfrac_nobio, veget_max, veget, soiltile, fraclut
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile, fraclut, nwdFraclut)
+    !
+    ! 0. Declarations
+    !
+    ! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                             :: kjpindex    !! Domain size - terrestrial pixels only
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)       :: lai         !! PFT leaf area index (m^{2} m^{-2})
+
+    ! 0.2 Modified variables 
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(inout) :: frac_nobio  !! Fraction of the mesh which is covered by ice, lakes, ...
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)    :: veget_max   !! Maximum fraction of vegetation type including none biological fraction (unitless)
+
+    ! 0.3 Output variables 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)      :: veget       !! Fraction of pixel covered by PFT. Fraction accounts for none-biological land covers (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: totfrac_nobio
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)    :: soiltile     !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out)    :: fraclut      !! Fraction of each landuse tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out)    :: nwdFraclut   !! Fraction of non-woody vegetation in each landuse tile (0-1, unitless)
+
+    ! 0.4 Local scalar and varaiables 
+    INTEGER(i_std)                                         :: ji, jv, jst !! indices 
+    REAL(r_std)                                            :: SUMveg      
+
+!_ ================================================================================================================================
+    IF (printlev_loc > 8) WRITE(numout,*) 'Entering slowproc_veget'
+
+    !! 1. Set to zero fractions of frac_nobio and veget_max smaller than min_vegfrac
+    !!    Normalize to have the sum equal 1.
+    DO ji = 1, kjpindex
+       IF ( SUM(frac_nobio(ji,:)) .LT. min_vegfrac ) THEN
+          frac_nobio(ji,:) = zero
+       ENDIF
+    
+       IF (.NOT. ok_dgvm) THEN
+          DO jv = 1, nvm
+             IF ( veget_max(ji,jv) .LT. min_vegfrac ) THEN
+                veget_max(ji,jv) = zero
+             ENDIF
+          ENDDO
+       END IF
+ 
+       !! Normalize to keep the sum equal 1.
+       SUMveg = SUM(frac_nobio(ji,:))+SUM(veget_max(ji,:))
+       frac_nobio(ji,:) = frac_nobio(ji,:)/SUMveg
+       veget_max(ji,:) = veget_max(ji,:)/SUMveg
+    ENDDO
+
+
+    !! 2. Calculate veget
+    !!    If lai of a vegetation type (jv > 1) is small, increase soil part
+    !!    stomate-like calculation
+    DO ji = 1, kjpindex
+       veget(ji,1)=veget_max(ji,1)
+       DO jv = 2, nvm
+          veget(ji,jv) = veget_max(ji,jv) * ( un - exp( - lai(ji,jv) * ext_coeff_vegetfrac(jv) ) )
+       ENDDO
+    ENDDO
+
+
+    !! 3. Calculate totfrac_nobio
+    totfrac_nobio(:) = zero
+    DO jv = 1, nnobio
+       totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,jv)
+    ENDDO
+    
+
+    !! 4. Calculate soiltiles
+    !! Soiltiles are only used in hydrol, but we fix them in here because some time it might depend
+    !! on a changing vegetation (but then some adaptation should be made to hydrol) and be also used
+    !! in the other modules to perform separated energy balances
+    ! 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   
+
+    !! 5. Calculate fraction of landuse tiles to be used only for diagnostic variables
+    fraclut(:,:)=0
+    nwdFraclut(:,id_psl)=0
+    nwdFraclut(:,id_crp)=1.
+    nwdFraclut(:,id_urb)=xios_default_val
+    nwdFraclut(:,id_pst)=xios_default_val
+    DO jv=1,nvm
+       IF (natural(jv)) THEN
+          fraclut(:,id_psl) = fraclut(:,id_psl) + veget_max(:,jv)
+          IF(.NOT. is_tree(jv)) THEN
+             nwdFraclut(:,id_psl) = nwdFraclut(:,id_psl) + veget_max(:,jv) 
+          ENDIF
+       ELSE
+          fraclut(:,id_crp) = fraclut(:,id_crp) + veget_max(:,jv)
+       ENDIF
+    END DO
+    
+    WHERE (fraclut(:,id_psl) > min_sechiba)
+       nwdFraclut(:,id_psl) = nwdFraclut(:,id_psl)/fraclut(:,id_psl)
+    ELSEWHERE
+       nwdFraclut(:,id_psl) = xios_default_val
+    END WHERE    
+
+  END SUBROUTINE slowproc_veget
+ 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_lai
+!!
+!>\BRIEF        Do the interpolation of lai for the PFTs in case the laimap is not read   
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) Interplation by using the mean value of laimin and laimax for the PFTs    
+!! (2) Interpolation between laimax and laimin values by using the temporal
+!!  variations 
+!! (3) If problem occurs during the interpolation, the routine stops 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_lai (kjpindex,lcanop,stempdiag,lalo,resolution,lai,laimap)
+    !
+    ! 0. Declarations
+    !
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex   !! Domain size - terrestrial pixels only
+    INTEGER(i_std), INTENT(in)                          :: lcanop     !! soil level used for LAI
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)  :: stempdiag  !! Soil temperature (K) ???
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo       !! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution !! Size in x an y of the grid (m) - surface area of the gridbox
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: laimap     !! map of lai read 
+
+    !! 0.2 Output
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)   :: lai        !! PFT leaf area index (m^{2} m^{-2})LAI
+
+    !! 0.4 Local
+    INTEGER(i_std)                                      :: ji,jv      !! Local indices 
+!_ ================================================================================================================================
+
+    !
+    IF  ( .NOT. read_lai ) THEN
+    
+       lai(: ,1) = zero
+       ! On boucle sur 2,nvm au lieu de 1,nvm
+       DO jv = 2,nvm
+          SELECT CASE (type_of_lai(jv))
+             
+          CASE ("mean ")
+             !
+             ! 1. do the interpolation between laimax and laimin
+             !
+             lai(:,jv) = undemi * (llaimax(jv) + llaimin(jv))
+             !
+          CASE ("inter")
+             !
+             ! 2. do the interpolation between laimax and laimin
+             !
+             DO ji = 1,kjpindex
+                lai(ji,jv) = llaimin(jv) + tempfunc(stempdiag(ji,lcanop)) * (llaimax(jv) - llaimin(jv))
+             ENDDO
+             !
+          CASE default
+             !
+             ! 3. Problem
+             !
+             WRITE (numout,*) 'This kind of lai choice is not possible. '// &
+                  ' We stop with type_of_lai ',jv,' = ', type_of_lai(jv) 
+             CALL ipslerr_p(3,'slowproc_lai','Bad value for type_of_lai','read_lai=false','')
+          END SELECT
+          
+       ENDDO
+       !
+    ELSE
+       lai(: ,1) = zero
+       ! On boucle sur 2,nvm au lieu de 1,nvm
+       DO jv = 2,nvm
+
+          SELECT CASE (type_of_lai(jv))
+             
+          CASE ("mean ")
+             !
+             ! 1. force MAXVAL of laimap on lai on this PFT
+             !
+             DO ji = 1,kjpindex
+                lai(ji,jv) = MAXVAL(laimap(ji,jv,:))
+             ENDDO
+             !
+          CASE ("inter")
+             !
+             ! 2. do the interpolation between laimax and laimin
+             !
+             !
+             ! If January
+             !
+             IF (month_end .EQ. 1 ) THEN
+                IF (day_end .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,12)*(1-(day_end+15)/30.) + laimap(:,jv,1)*((day_end+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,1)*(1-(day_end-15)/30.) + laimap(:,jv,2)*((day_end-15)/30.)
+                ENDIF
+                !
+                ! If December
+                !
+             ELSE IF (month_end .EQ. 12) THEN
+                IF (day_end .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,11)*(1-(day_end+15)/30.) + laimap(:,jv,12)*((day_end+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,12)*(1-(day_end-15)/30.) + laimap(:,jv,1)*((day_end-15)/30.)
+                ENDIF
+          !
+          ! ELSE
+          !
+             ELSE
+                IF (day_end .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,month_end-1)*(1-(day_end+15)/30.) + laimap(:,jv,month_end)*((day_end+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,month_end)*(1-(day_end-15)/30.) + laimap(:,jv,month_end+1)*((day_end-15)/30.)
+                ENDIF
+             ENDIF
+             !
+          CASE default
+             !
+             ! 3. Problem
+             !
+             WRITE (numout,*) 'This kind of lai choice is not possible. '// &
+                  ' We stop with type_of_lai ',jv,' = ', type_of_lai(jv) 
+             CALL ipslerr_p(3,'slowproc_lai','Bad value for type_of_lai','read_lai=true','')
+          END SELECT
+          
+       ENDDO
+    ENDIF
+
+  END SUBROUTINE slowproc_lai
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interlai
+!!
+!>\BRIEF         Interpolate the LAI map to the grid of the model 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::laimap
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_interlai(nbpt, lalo, resolution, neighbours, contfrac, laimap)
+
+    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(out)    ::  laimap(nbpt,nvm,12)          !! lai read variable and re-dimensioned
+    !
+    !  0.3 LOCAL
+    !
+    CHARACTER(LEN=80) :: filename                               !! name of the LAI map read
+    INTEGER(i_std) :: 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(nbpt,nvm,12)                  :: lairefrac        !! lai fractions re-dimensioned
+    REAL(r_std), DIMENSION(nbpt,nvm,12)                  :: fraclaiinterp    !! 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 
+!_ ================================================================================================================================
+
+    !
+    !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 (xios_interpolation) THEN
+       IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_interlai: Use XIOS to read and interpolate " &
+            // TRIM(filename) //" for variable " //TRIM(variablename)
+    
+       CALL xios_orchidee_recv_field('lai_interp',lairefrac)
+       CALL xios_orchidee_recv_field('frac_lai_interp',fraclaiinterp)      
+       alaimap(:) = fraclaiinterp(:,1,1)
+    ELSE
+
+      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','','')
+
+
+! 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'
+
+    ENDIF
+
+
+
+    !
+    !
+    !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) < min_sechiba) THEN
+        DO jv=1,nvm
+          laimap(ib,jv,:) = (llaimax(jv)+llaimin(jv))/deux
+        ENDDO
+      ELSE
+        DO jv=1, nvm
+          DO it=1, 12
+            laimap(ib,jv,it) = lairefrac(ib,jv,it)
+          ENDDO
+        ENDDO
+      END IF
+    ENDDO
+    !
+    ! Normelize the read LAI by the values SECHIBA is used to
+    !
+    IF ( renormelize_lai ) THEN
+       DO ib=1,nbpt
+          DO jv=1, nvm
+             lmax = MAXVAL(laimap(ib,jv,:))
+             lmin = MINVAL(laimap(ib,jv,:))
+             ldelta = lmax-lmin
+             IF ( ldelta < min_sechiba) THEN
+                ! LAI constante ... keep it constant
+                laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)+(llaimax(jv)+llaimin(jv))/deux
+             ELSE
+                laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)/(lmax-lmin)*(llaimax(jv)-llaimin(jv))+llaimin(jv)
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+
+    ! Write diagnostics
+    CALL xios_orchidee_send_field("alaimap",alaimap)
+    CALL xios_orchidee_send_field("interp_diag_lai",laimap)
+   
+    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,         & 
+       veget_next, 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      !! old max vegetfrac
+    INTEGER(i_std), INTENT(in)         :: veget_year            !! first year for landuse (0 == NO TIME AXIS)
+    LOGICAL, INTENT(in)                :: init                  !! initialisation : in case of dgvm, it forces update of all PFTs
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), DIMENSION(nbpt,nvm), INTENT(out)          :: veget_next       !! new max vegetfrac
+    REAL(r_std), DIMENSION(nbpt,nnobio), INTENT(out)       :: frac_nobio_next  !! new fraction of the mesh which is 
+                                                                               !! covered by ice, lakes, ...
+    
+    !
+    !  0.3 LOCAL
+    !
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: ib, inobio, jv
+    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,nvm)                     :: vegetrefrac      !! veget fractions re-dimensioned
+    REAL(r_std), DIMENSION(nbpt)                         :: aveget           !! Availability of the soilcol interpolation
+    REAL(r_std), DIMENSION(nbpt,nvm)                     :: aveget_nvm       !! Availability of the soilcol interpolation
+    REAL(r_std), DIMENSION(nvm)                          :: 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 
+    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 (xios_interpolation) THEN
+       IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_readvegetmax: Use XIOS to read and interpolate " &
+            // TRIM(filename) // " for variable " // TRIM(variablename)
+
+       CALL xios_orchidee_recv_field('frac_veget',vegetrefrac)
+       CALL xios_orchidee_recv_field('frac_veget_frac',aveget_nvm)
+       aveget(:)=aveget_nvm(:,1)
+       
+       DO ib = 1, nbpt
+          IF (aveget(ib) > min_sechiba) THEN
+             vegetrefrac(ib,:) = vegetrefrac(ib,:)/aveget(ib) ! intersected area normalization
+             vegetrefrac(ib,:) = vegetrefrac(ib,:)/SUM(vegetrefrac(ib,:))
+          ENDIF
+       ENDDO
+       
+    ELSE
+
+      IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_readvegetmax: Start interpolate " &
+           // TRIM(filename) // " for variable " // TRIM(variablename)
+
+      ! Assigning values to vmin, vmax
+      vmin = 1
+      vmax = nvm*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, 0., 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, nvm, variabletypevals, lalo, resolution, neighbours,        &
+        contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,        &
+        maskvals, namemaskvar, nvm, 0, veget_year, fractype,                                 &
+        -1., -1., vegetrefrac, aveget)
+      IF (printlev_loc >= 5) WRITE(numout,*)'  slowproc_readvegetmax after interpeeight_3D'
+    ENDIF 
+    !
+    ! 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:nvm) = 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 utpdated, the others are copied from previous time-step 
+             veget_next(ib,:) = veget_last(ib,:)
+             
+             DO jv = 2, nvm
+                IF ( .NOT. natural(jv) ) THEN       
+                   veget_next(ib,jv) = vegetrefrac(ib,jv)
+                ENDIF
+             ENDDO
+
+             sumvAnthro_old = zero
+             sumvAnthro     = zero
+             DO jv = 2, nvm
+                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, nvm
+                   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, nvm
+                   IF ( natural(jv) ) THEN
+                      veget_next(ib,jv) = veget_last(ib,jv)
+                   ENDIF
+                ENDDO
+                veget_next(ib,1) = veget_next(ib,1) + sumvAnthro_old - sumvAnthro
+             ENDIF
+
+             ! test
+             IF ( ABS( SUM(veget_next(ib,:)) - sum_veg ) > 10*EPSILON(un) ) THEN
+                WRITE(numout,*) '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
+    !
+!MM
+    ! Work only for one nnobio !! (ie ice)
+    DO inobio=1,nnobio
+       DO jv=1,nvm
+          DO ib = 1, nbpt
+             frac_nobio_next(ib,inobio) = frac_nobio_next(ib,inobio) - veget_next(ib,jv)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DO ib = 1, nbpt
+       sum_veg = SUM(veget_next(ib,:))
+       sum_nobio = SUM(frac_nobio_next(ib,:))
+       IF (sum_nobio < 0.) THEN
+          frac_nobio_next(ib,:) = zero
+          veget_next(ib,1) = veget_next(ib,1) + sum_nobio
+          sum_veg = SUM(veget_next(ib,:))
+       ENDIF
+       sumf = sum_veg + sum_nobio
+       IF (sumf > min_sechiba) THEN
+          veget_next(ib,:) = veget_next(ib,:) / sumf
+          frac_nobio_next(ib,:) = frac_nobio_next(ib,:) / sumf
+          norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
+          err=norm-un
+          IF (printlev_loc >=5) WRITE(numout,*) "  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:nvm) = zero
+          frac_nobio_next(ib,:) = zero
+!!!$          CALL ipslerr_p (3,'slowproc_readvegetmax', &
+!!!$               &          'Problem with vegetation file for Land Use.', &
+!!!$               &          "No vegetation nor frac_nobio for point ", &
+!!!$               &          '(verify your land use file.)')
+       ENDIF
+    ENDDO
+
+    ! Write diagnostics
+    CALL xios_orchidee_send_field("aveget",aveget)
+    CALL xios_orchidee_send_field("interp_diag_aveget",aveget)
+    CALL xios_orchidee_send_field("interp_diag_vegetrefrac",vegetrefrac)
+
+    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
+!!
+!! 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)
+
+    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)
+    !
+    !
+    !  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)                                          :: 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
+    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)
+
+    variablename = 'soiltext'
+
+    !! Variables for interpweight
+    ! Type of calculation of cell fractions
+    fractype = 'default'
+
+    IF (xios_interpolation) THEN
+       IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Use XIOS to read and interpolate " &
+            // TRIM(filename) // " for variable " // TRIM(variablename)
+       
+       SELECT CASE(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
+          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(textrefrac(nbpt,nzobler))
+          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)
+       
+          CALL xios_orchidee_recv_field('soiltext1',textrefrac(:,1))
+          CALL xios_orchidee_recv_field('soiltext2',textrefrac(:,2))
+          CALL xios_orchidee_recv_field('soiltext3',textrefrac(:,3))
+          CALL xios_orchidee_recv_field('soiltext4',textrefrac(:,4))
+          CALL xios_orchidee_recv_field('soiltext5',textrefrac(:,5))
+          CALL xios_orchidee_recv_field('soiltext6',textrefrac(:,6))
+          CALL xios_orchidee_recv_field('soiltext7',textrefrac(:,7))
+
+
+       
+          CALL get_soilcorr_zobler (nzobler, textfrac_table)
+        !
+        !
+          DO ib =1, nbpt
+            soilclass(ib,1)=textrefrac(ib,1)
+            soilclass(ib,2)=textrefrac(ib,2)+textrefrac(ib,3)+textrefrac(ib,4)+textrefrac(ib,7)
+            soilclass(ib,3)=textrefrac(ib,5)
+            
+            ! 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) = textfrac_table(1,3) * textrefrac(ib,1)+textfrac_table(2,3) * textrefrac(ib,2) + &
+                               textfrac_table(3,3) * textrefrac(ib,3)+textfrac_table(4,3) * textrefrac(ib,4) + &
+                               textfrac_table(5,3) * textrefrac(ib,5)+textfrac_table(7,3) * textrefrac(ib,7)
+            sandfraction(ib) = textfrac_table(1,2) * textrefrac(ib,1)+textfrac_table(2,2) * textrefrac(ib,2) + &
+                               textfrac_table(3,2) * textrefrac(ib,3)+textfrac_table(4,2) * textrefrac(ib,4) + &
+                               textfrac_table(5,2) * textrefrac(ib,5)+textfrac_table(7,2) * textrefrac(ib,7)
+
+            siltfraction(ib) = textfrac_table(1,2) * textrefrac(ib,1)+textfrac_table(2,2) * textrefrac(ib,2) + &
+                               textfrac_table(3,2) * textrefrac(ib,3)+textfrac_table(4,2) * textrefrac(ib,4) + &
+                               textfrac_table(5,2) * textrefrac(ib,5)+textfrac_table(7,2) * textrefrac(ib,7)
+
+            sgn=SUM(soilclass(ib,1:3))
+            
+            IF (sgn < min_sechiba) THEN
+              soilclass(ib,:) = soilclass_default(:)
+              clayfraction(ib) = clayfraction_default
+              sandfraction(ib) = sandfraction_default
+              siltfraction(ib) = siltfraction_default
+              atext(ib)=0.
+            ELSE
+              atext(ib)=sgn
+              clayfraction(ib) = clayfraction(ib) / sgn
+              sandfraction(ib) = sandfraction(ib) / sgn
+              siltfraction(ib) = siltfraction(ib) / sgn
+              soilclass(ib,1:3) = soilclass(ib,1:3) / sgn
+            ENDIF
+            
+          ENDDO
+          
+          
+       
+       CASE('usda')
+
+           IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: start case usda'
+ 
+           soilclass_default=soilclass_default_usda
+           !
+           WRITE(numout,*) "Using a soilclass map with usda classification"
+           !
+           ALLOCATE(textrefrac(nbpt,nscm))
+           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'
+
+          CALL xios_orchidee_recv_field('soiltext1',textrefrac(:,1))
+          CALL xios_orchidee_recv_field('soiltext2',textrefrac(:,2))
+          CALL xios_orchidee_recv_field('soiltext3',textrefrac(:,3))
+          CALL xios_orchidee_recv_field('soiltext4',textrefrac(:,4))
+          CALL xios_orchidee_recv_field('soiltext5',textrefrac(:,5))
+          CALL xios_orchidee_recv_field('soiltext6',textrefrac(:,6))
+          CALL xios_orchidee_recv_field('soiltext7',textrefrac(:,7))
+          CALL xios_orchidee_recv_field('soiltext8',textrefrac(:,8))
+          CALL xios_orchidee_recv_field('soiltext9',textrefrac(:,9))
+          CALL xios_orchidee_recv_field('soiltext10',textrefrac(:,10))
+          CALL xios_orchidee_recv_field('soiltext11',textrefrac(:,11))
+          CALL xios_orchidee_recv_field('soiltext12',textrefrac(:,12))
+
+
+       
+          CALL get_soilcorr_usda (nscm, textfrac_table)
+          IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: After get_soilcorr_usda'      
+
+          DO ib =1, nbpt
+            clayfraction(ib) = 0.0
+            DO ilf = 1,nscm
+              soilclass(ib,ilf)=textrefrac(ib,ilf)      
+              clayfraction(ib) = clayfraction(ib) + textfrac_table(ilf,3)*textrefrac(ib,ilf)
+              sandfraction(ib) = sandfraction(ib) + textfrac_table(ilf,2)*textrefrac(ib,ilf)
+              siltfraction(ib) = siltfraction(ib) + textfrac_table(ilf,1)*textrefrac(ib,ilf)
+            ENDDO
+
+
+            sgn=SUM(soilclass(ib,:))
+            
+            IF (sgn < min_sechiba) THEN
+              soilclass(ib,:) = soilclass_default(:)
+              clayfraction(ib) = clayfraction_default
+              sandfraction(ib) = sandfraction_default
+              siltfraction(ib) = siltfraction_default
+              atext(ib)=0
+            ELSE
+              soilclass(ib,:) = soilclass(ib,:) / sgn
+              clayfraction(ib) = clayfraction(ib) / sgn
+              sandfraction(ib) = sandfraction(ib) / sgn
+              siltfraction(ib) = siltfraction(ib) / sgn
+              atext(ib)=sgn
+            ENDIF
+          ENDDO
+
+        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','','')
+        END SELECT
+
+
+
+    ELSE              !    xios_interpolation 
+       ! Read and interpolate using stardard method with IOIPSL and aggregate
+    
+       IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Read and interpolate " &
+            // TRIM(filename) // " for variable " // TRIM(variablename)
+
+
+       ! Name of the longitude and latitude in the input file
+       lonname = 'nav_lon'
+       latname = 'nav_lat'
+
+       IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_soilt: Start interpolate " &
+            // TRIM(filename) // " for variable " // TRIM(variablename)
+
+       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',&
+            '','')
+
+          ! Assigning values to vmin, vmax
+          vmin = un
+          vmax = ntextinfile*un
+          
+          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 = ''
+          
+          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)
+
+          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
+                END IF
+             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
+          
+          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)
+    
+    ENDIF        !      xios_interpolation 
+    
+    ! Write diagnostics
+    CALL xios_orchidee_send_field("atext",atext)
+
+    CALL xios_orchidee_send_field("interp_diag_atext",atext)
+    CALL xios_orchidee_send_field("interp_diag_soilclass",soilclass)
+    CALL xios_orchidee_send_field("interp_diag_clayfraction",clayfraction)
+    
+    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)
+
+    IF (xios_interpolation) THEN
+    
+      CALL xios_orchidee_recv_field('reinf_slope_interp',reinf_slope)
+      CALL xios_orchidee_recv_field('frac_slope_interp',aslope)
+
+
+    ELSE
+    
+      variablename = 'pente'
+      IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_slope: Read and interpolate " &
+           // TRIM(filename) // " for variable " // 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.
+
+      !! 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'
+
+    ENDIF
+    
+      ! Write diagnostics
+    CALL xios_orchidee_send_field("aslope",aslope)
+    CALL xios_orchidee_send_field("interp_diag_aslope",aslope)
+
+    CALL xios_orchidee_send_field("interp_diag_reinf_slope",reinf_slope)
+
+    IF (printlev_loc >= 3) WRITE(numout,*) '  slowproc_slope ended'
+
+  END SUBROUTINE slowproc_slope
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_woodharvest
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_woodharvest(nbpt, lalo, neighbours, resolution, contfrac, woodharvest)
+
+    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
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)            ::  woodharvest !! Wood harvest
+    !
+    !  0.3 LOCAL
+    !
+    CHARACTER(LEN=80)                                    :: filename
+    REAL(r_std)                                          :: vmin, vmax  
+    REAL(r_std), DIMENSION(nbpt)                         :: aoutvar          !! availability of input data to
+                                                                             !!   interpolate output variable 
+                                                                             !!   (on the nbpt space)
+    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 
+    REAL(r_std), DIMENSION(1)                            :: variabletypevals !! 
+!    REAL(r_std), DIMENSION(nbp_mpi)                      :: woodharvest_mpi  !! Wood harvest where all thredds OMP are gatherd
+!_ ================================================================================================================================
+    
+    
+    !Config Key   = WOODHARVEST_FILE
+    !Config Desc  = Name of file from which the wood harvest will be read
+    !Config If    = DO_WOOD_HARVEST
+    !Config Def   = woodharvest.nc
+    !Config Help  = 
+    !Config Units = [FILE]
+    filename = 'woodharvest.nc'
+    CALL getin_p('WOODHARVEST_FILE',filename)
+    variablename = 'woodharvest'
+
+
+    IF (xios_interpolation) THEN
+       IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_readwoodharvest: Use XIOS to read and interpolate " &
+            // TRIM(filename) // " for variable " // TRIM(variablename)
+
+       CALL xios_orchidee_recv_field('woodharvest_interp',woodharvest)
+
+       aoutvar = 1.0
+    ELSE
+
+       IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_readwoodharvest: Read and interpolate " &
+            // TRIM(filename) // " for variable " // 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.
+       
+       !! 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 = '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 = ''
+       
+       variabletypevals=-un
+       CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours,                                &
+            contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype,        &
+            maskvals, namemaskvar, -1, fractype, 0., 0., woodharvest, aoutvar)
+       IF (printlev_loc >= 5) WRITE(numout,*)'  slowproc_wodharvest after interpweight_2Dcont'
+       
+       IF (printlev_loc >= 3) WRITE(numout,*) '  slowproc_woodharvest ended'
+    END IF
+  END SUBROUTINE slowproc_woodharvest
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_soilcorr_zobler
+!!
+!>\BRIEF         The "get_soilcorr" routine defines the table of correspondence
+!!               between the Zobler types and the three texture types known by SECHIBA and STOMATE :
+!!               silt, sand and clay. 
+!!
+!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
+!!               The data from this file is then interpolated to the grid of the model. \n
+!!               The aim is to get fractions for sand loam and clay in each grid box.\n
+!!               This information is used for soil hydrology and respiration.
+!!
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
+!!
+!! REFERENCE(S)	: 
+!! - Zobler L., 1986, A World Soil File for global climate modelling. NASA Technical memorandum 87802. NASA 
+!!   Goddard Institute for Space Studies, New York, U.S.A.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_soilcorr_zobler (nzobler,textfrac_table)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    INTEGER(i_std),PARAMETER :: nbtypes_zobler = 7                    !! Number of Zobler types (unitless)
+
+    !! 0.1  Input variables
+    
+    INTEGER(i_std),INTENT(in) :: nzobler                              !! Size of the array (unitless)
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION(nzobler,ntext),INTENT(out) :: textfrac_table !! Table of correspondence between soil texture class
+                                                                       !! and granulometric composition (0-1, unitless)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std) :: ib                                              !! Indice (unitless)
+    
+!_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-  
+    IF (nzobler /= nbtypes_zobler) THEN 
+       CALL ipslerr_p(3,'get_soilcorr', 'nzobler /= nbtypes_zobler',&
+          &   'We do not have the correct number of classes', &
+          &                 ' in the code for the file.')  ! Fatal error
+    ENDIF
+
+    !-
+    ! 1. Textural fraction for : silt        sand         clay
+    !-
+    textfrac_table(1,:) = (/ 0.12, 0.82, 0.06 /)
+    textfrac_table(2,:) = (/ 0.32, 0.58, 0.10 /)
+    textfrac_table(3,:) = (/ 0.39, 0.43, 0.18 /)
+    textfrac_table(4,:) = (/ 0.15, 0.58, 0.27 /)
+    textfrac_table(5,:) = (/ 0.34, 0.32, 0.34 /)
+    textfrac_table(6,:) = (/ 0.00, 1.00, 0.00 /)
+    textfrac_table(7,:) = (/ 0.39, 0.43, 0.18 /)
+
+
+    !-
+    ! 2. Check the mapping for the Zobler types which are going into the ORCHIDEE textures classes 
+    !-
+    DO ib=1,nzobler ! Loop over # classes soil
+       
+       IF (ABS(SUM(textfrac_table(ib,:))-1.0) > EPSILON(1.0)) THEN ! The sum of the textural fractions should not exceed 1 !
+          WRITE(numout,*) &
+               &     'Error in the correspondence table', &
+               &     ' sum is not equal to 1 in', ib
+          WRITE(numout,*) textfrac_table(ib,:)
+          CALL ipslerr_p(3,'get_soilcorr', 'SUM(textfrac_table(ib,:)) /= 1.0',&
+               &                 '', 'Error in the correspondence table') ! Fatal error
+       ENDIF
+       
+    ENDDO ! Loop over # classes soil
+
+    
+  END SUBROUTINE get_soilcorr_zobler
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_soilcorr_usda
+!!
+!>\BRIEF         The "get_soilcorr_usda" routine defines the table of correspondence
+!!               between the 12 USDA textural classes and their granulometric composition, 
+!!               as % of silt, sand and clay. This is used to further defien clayfraction.
+!!
+!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
+!!               The data from this file is then interpolated to the grid of the model. \n
+!!               The aim is to get fractions for sand loam and clay in each grid box.\n
+!!               This information is used for soil hydrology and respiration.
+!!               The default map in this case is derived from Reynolds et al 2000, \n
+!!               at the 1/12deg resolution, with indices that are consistent with the \n
+!!               textures tabulated below
+!!
+!! RECENT CHANGE(S): Created by A. Ducharne on July 02, 2014
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_soilcorr_usda (nusda,textfrac_table)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    !! 0.1  Input variables
+    
+    INTEGER(i_std),INTENT(in) :: nusda                               !! Size of the array (unitless)
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION(nusda,ntext),INTENT(out) :: textfrac_table !! Table of correspondence between soil texture class
+                                                                     !! and granulometric composition (0-1, unitless)
+    
+    !! 0.4 Local variables
+
+    INTEGER(i_std),PARAMETER :: nbtypes_usda = 12                    !! Number of USDA texture classes (unitless)
+    INTEGER(i_std) :: n                                              !! Index (unitless)
+    
+!_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-  
+    IF (nusda /= nbtypes_usda) THEN 
+       CALL ipslerr_p(3,'get_soilcorr', 'nusda /= nbtypes_usda',&
+          &   'We do not have the correct number of classes', &
+          &                 ' in the code for the file.')  ! Fatal error
+    ENDIF
+
+    !! Parameters for soil type distribution :
+    !! Sand, Loamy Sand, Sandy Loam, Silt Loam, Silt, Loam, Sandy Clay Loam, Silty Clay Loam, Clay Loam, Sandy Clay, Silty Clay, Clay
+    ! The order comes from constantes_soil.f90
+    ! The corresponding granulometric composition comes from Carsel & Parrish, 1988
+
+    !-
+    ! 1. Textural fractions for : sand, clay
+    !-
+    textfrac_table(1,2:3)  = (/ 0.93, 0.03 /) ! Sand
+    textfrac_table(2,2:3)  = (/ 0.81, 0.06 /) ! Loamy Sand
+    textfrac_table(3,2:3)  = (/ 0.63, 0.11 /) ! Sandy Loam
+    textfrac_table(4,2:3)  = (/ 0.17, 0.19 /) ! Silt Loam
+    textfrac_table(5,2:3)  = (/ 0.06, 0.10 /) ! Silt
+    textfrac_table(6,2:3)  = (/ 0.40, 0.20 /) ! Loam
+    textfrac_table(7,2:3)  = (/ 0.54, 0.27 /) ! Sandy Clay Loam
+    textfrac_table(8,2:3)  = (/ 0.08, 0.33 /) ! Silty Clay Loam
+    textfrac_table(9,2:3)  = (/ 0.30, 0.33 /) ! Clay Loam
+    textfrac_table(10,2:3) = (/ 0.48, 0.41 /) ! Sandy Clay
+    textfrac_table(11,2:3) = (/ 0.06, 0.46 /) ! Silty Clay
+    textfrac_table(12,2:3) = (/ 0.15, 0.55 /) ! Clay
+
+    ! Fraction of silt
+
+    DO n=1,nusda
+       textfrac_table(n,1) = 1. - textfrac_table(n,2) - textfrac_table(n,3)
+    END DO
+       
+  END SUBROUTINE get_soilcorr_usda
+
+!! ================================================================================================================================
+!! FUNCTION 	: tempfunc
+!!
+!>\BRIEF        ! This function interpolates value between ztempmin and ztempmax
+!! used for lai detection. 
+!!
+!! DESCRIPTION   : This subroutine calculates a scalar between 0 and 1 with the following equation :\n
+!!                 \latexonly
+!!                 \input{constantes_veg_tempfunc.tex}
+!!                 \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tempfunc_result
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION tempfunc (temp_in) RESULT (tempfunc_result)
+
+
+    !! 0. Variables and parameters declaration
+
+    REAL(r_std),PARAMETER    :: ztempmin=273._r_std   !! Temperature for laimin (K)
+    REAL(r_std),PARAMETER    :: ztempmax=293._r_std   !! Temperature for laimax (K)
+    REAL(r_std)              :: zfacteur              !! Interpolation factor   (K^{-2})
+
+    !! 0.1 Input variables
+
+    REAL(r_std),INTENT(in)   :: temp_in               !! Temperature (K)
+
+    !! 0.2 Result
+
+    REAL(r_std)              :: tempfunc_result       !! (unitless)
+    
+!_ ================================================================================================================================
+
+    !! 1. Define a coefficient
+    zfacteur = un/(ztempmax-ztempmin)**2
+    
+    !! 2. Computes tempfunc
+    IF     (temp_in > ztempmax) THEN
+       tempfunc_result = un
+    ELSEIF (temp_in < ztempmin) THEN
+       tempfunc_result = zero
+    ELSE
+       tempfunc_result = un-zfacteur*(ztempmax-temp_in)**2
+    ENDIF !(temp_in > ztempmax)
+
+
+  END FUNCTION tempfunc
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_checkveget
+!!
+!>\BRIEF         To verify the consistency of the various fractions defined within the grid box after having been
+!!               been updated by STOMATE or the standard procedures.
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: none
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!
+  SUBROUTINE slowproc_checkveget(nbpt, frac_nobio, veget_max, veget, tot_bare_soil, soiltile)
+
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                      :: nbpt       ! Number of points for which the data needs to be interpolated
+    REAL(r_std),DIMENSION (nbpt,nnobio), INTENT(in) :: frac_nobio ! Fraction of ice,lakes,cities, ... (unitless)
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in)    :: veget_max  ! Maximum fraction of vegetation type including none biological fraction (unitless) 
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in)    :: veget      ! Vegetation fractions
+    REAL(r_std),DIMENSION (nbpt), INTENT(in)        :: tot_bare_soil ! Total evaporating bare soil fraction within the mesh
+    REAL(r_std),DIMENSION (nbpt,nstm), INTENT(in)   :: soiltile   ! Fraction of soil tiles in the gridbox (unitless)
+
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std) :: ji, jn, jv
+    REAL(r_std)  :: epsilocal  !! A very small value
+    REAL(r_std)  :: totfrac
+    CHARACTER(len=80) :: str1, str2
+    
+!_ ================================================================================================================================
+    
+    !
+    ! There is some margin added as the computing errors might bring us above EPSILON(un)
+    !
+    epsilocal = EPSILON(un)*1000.
+    
+    !! 1.0 Verify that none of the fractions are smaller than min_vegfrac, without beeing zero.
+    !!
+    DO ji=1,nbpt
+       DO jn=1,nnobio
+          IF ( frac_nobio(ji,jn) > epsilocal .AND. frac_nobio(ji,jn) < min_vegfrac ) THEN
+             WRITE(str1,'("Occurs on grid box", I8," and nobio type ",I3 )') ji, jn
+             WRITE(str2,'("The small value obtained is ", E14.4)') frac_nobio(ji,jn)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                  "frac_nobio is larger than zero but smaller than min_vegfrac.", str1, str2)
+          ENDIF
+       ENDDO
+    END DO
+    
+    IF (.NOT. ok_dgvm) THEN       
+       DO ji=1,nbpt
+          DO jv=1,nvm
+             IF ( veget_max(ji,jv) > epsilocal .AND. veget_max(ji,jv) < min_vegfrac ) THEN
+                WRITE(str1,'("Occurs on grid box", I8," and nobio type ",I3 )') ji, jn
+                WRITE(str2,'("The small value obtained is ", E14.4)') veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget_max is larger than zero but smaller than min_vegfrac.", str1, str2)
+             ENDIF
+          ENDDO
+       ENDDO
+    END IF
+    
+    !! 2.0 verify that with all the fractions we cover the entire grid box  
+    !!
+    DO ji=1,nbpt
+       totfrac = zero
+       DO jn=1,nnobio
+          totfrac = totfrac + frac_nobio(ji,jn)
+       ENDDO
+       DO jv=1,nvm
+          totfrac = totfrac + veget_max(ji,jv)
+       ENDDO
+       IF ( ABS(totfrac - un) > epsilocal) THEN
+             WRITE(str1,'("This occurs on grid box", I8)') ji
+             WRITE(str2,'("The sum over all fraction and error are ", E14.4, E14.4)') totfrac, ABS(totfrac - un)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                   "veget_max + frac_nobio is not equal to 1.", str1, str2)
+             WRITE(*,*) "EPSILON =", epsilocal 
+       ENDIF
+    ENDDO
+    
+    !! 3.0 Verify that veget is smaller or equal to veget_max
+    !!
+    DO ji=1,nbpt
+       DO jv=1,nvm
+          IF ( jv == ibare_sechiba ) THEN
+             IF ( ABS(veget(ji,jv) - veget_max(ji,jv)) > epsilocal ) THEN
+                WRITE(str1,'("This occurs on grid box", I8)') ji
+                WRITE(str2,'("The difference is ", E14.4)') veget(ji,jv) - veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget is not equal to veget_max on bare soil.", str1, str2)
+             ENDIF
+          ELSE
+             IF ( veget(ji,jv) > veget_max(ji,jv) ) THEN
+                WRITE(str1,'("This occurs on grid box", I8)') ji
+                WRITE(str2,'("The values for veget and veget_max :", F8.4, F8.4)') veget(ji,jv), veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget is greater than veget_max.", str1, str2)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    !! 4.0 Test tot_bare_soil in relation to the other variables
+    !!
+    DO ji=1,nbpt
+       totfrac = zero
+       DO jv=1,nvm
+          totfrac = totfrac + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+       ! add the bare soil fraction to totfrac
+       totfrac = totfrac + veget(ji,ibare_sechiba)
+       ! do the test
+       IF ( ABS(totfrac - tot_bare_soil(ji)) > epsilocal ) THEN
+          WRITE(str1,'("This occurs on grid box", I8)') ji
+          WRITE(str2,'("The values for tot_bare_soil, tot frac and error :", F8.4, F8.4, E14.4)') &
+               &  tot_bare_soil(ji), totfrac, ABS(totfrac - tot_bare_soil(ji))
+          CALL ipslerr_p (3,'slowproc_checkveget', &
+               "tot_bare_soil does not correspond to the total bare soil fraction.", str1, str2)
+       ENDIF
+    ENDDO
+    
+    !! 5.0 Test that soiltile has the right sum
+    !!
+    DO ji=1,nbpt
+       totfrac = SUM(soiltile(ji,:))
+       IF ( ABS(totfrac - un) > epsilocal ) THEN
+          WRITE(numout,*) "soiltile does not sum-up to one. This occurs on grid box", ji
+          WRITE(numout,*) "The soiltile for ji are :", soiltile(ji,:)
+          CALL ipslerr_p (2,'slowproc_checkveget', &
+               "soiltile does not sum-up to one.", "", "")
+       ENDIF
+    ENDDO
+    
+  END SUBROUTINE slowproc_checkveget
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_change_frac
+!!
+!>\BRIEF        Update the vegetation fractions
+!!
+!! DESCRIPTION  : Update the vegetation fractions. This subroutine is called in the same time step as lcchange in stomatelpj has
+!!                has been done. This subroutine is called after the diagnostics have been written in sechiba_main.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: veget_max, veget, frac_nobio, totfrac_nobio, tot_bare_soil, soiltile
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+   
+  SUBROUTINE slowproc_change_frac(kjpindex, lai, &
+                                  veget_max, veget, frac_nobio, totfrac_nobio, tot_bare_soil, soiltile, fraclut, nwdFraclut)
+    !
+    ! 0. Declarations
+    !
+    ! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)     :: lai            !! Leaf area index (m^2 m^{-2})
+    
+    ! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out)    :: veget_max      !! Maximum fraction of vegetation type in the mesh (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 etc. in the mesh
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)        :: totfrac_nobio  !! Total fraction of ice+lakes+cities etc. in the mesh
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)       :: tot_bare_soil  !! Total evaporating bare soil fraction in the mesh
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)  :: soiltile       !! Fraction of each soil tile within vegtot (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out)  :: fraclut        !! Fraction of each landuse tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out)  :: nwdfraclut     !! Fraction of non woody vegetation in each landuse tile (0-1, unitless)
+    
+    ! 0.3 Local variables
+    INTEGER(i_std)                                       :: ji, jv         !! Loop index
+    
+       
+    !! Update vegetation fractions with the values coming from the vegetation file read in slowproc_readvegetmax.
+    !! Partial update has been taken into account for the case with DGVM and AGRICULTURE in slowproc_readvegetmax.
+    veget_max  = veget_max_new
+    frac_nobio = frac_nobio_new
+       
+    !! Verification and correction on veget_max, calculation of veget and soiltile.
+    CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile, fraclut, nwdFraclut)
+    
+    !! Calculate tot_bare_soil needed in hydrol, diffuco and condveg (fraction of bare soil in the mesh)
+    tot_bare_soil(:) = veget_max(:,1)
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          tot_bare_soil(ji) = tot_bare_soil(ji) + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+    END DO
+
+    !! Do some basic tests on the surface fractions updated above 
+    CALL slowproc_checkveget(kjpindex, frac_nobio, veget_max, veget, tot_bare_soil, soiltile)
+     
+  END SUBROUTINE slowproc_change_frac 
+
+END MODULE slowproc
Index: /branches/publications/ORCHIDEE-AFP/src_sechiba/thermosoil.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_sechiba/thermosoil.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_sechiba/thermosoil.f90	(revision 8430)
@@ -0,0 +1,1936 @@
+! =================================================================================================================================
+! MODULE       : thermosoil
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_day, dt_sechiba
+  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, thermosoil_xios_initialize
+
+  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                  !! ptn as it is after thermosoil_profile but before thermosoil_coef, 
+                                                                              !! used in thermosoil_readjust
+!$OMP THREADPRIVATE(ptn_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: temp_sol_beg             !! Surface temperature at previous timestep (K) 
+!$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_xios_initialize
+!!
+!>\BRIEF	  Initialize xios dependant defintion before closing context defintion
+!!
+!! DESCRIPTION:	  Initialize xios dependant defintion before closing context defintion
+!!                Reading is deactivated if the sechiba restart file exists because the
+!!                variable should be in the restart file already. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE thermosoil_xios_initialize
+
+    CHARACTER(LEN=255) :: filename, name
+        
+    filename = 'reftemp.nc'
+    CALL getin_p('REFTEMP_FILE',filename)
+    
+    name = filename(1:LEN_TRIM(FILENAME)-3)
+    CALL xios_orchidee_set_file_attr("reftemp_file",name=name)
+
+    ! Check if the reftemp file will be read by XIOS, by IOIPSL or not at all    
+    IF (xios_interpolation .AND. read_reftemp .AND. restname_in=='NONE') THEN
+       ! The reftemp file will be read using XIOS
+       IF (printlev>=2) WRITE(numout,*) 'Reading of reftemp file will be done later using XIOS. The filename is ', filename
+    ELSE
+       IF (.NOT. read_reftemp) THEN
+          IF (printlev>=2) WRITE (numout,*) 'No reading of reftemp will be done because read_reftemp=FALSE'
+       ELSE IF (restname_in=='NONE') THEN
+          IF (printlev>=2) WRITE (numout,*) 'The reftemp file will be read later by IOIPSL'
+       ELSE
+          IF (printlev>=2) WRITE (numout,*) 'The reftemp file will not be read because the restart file exists.'
+       END IF
+
+       ! The reftemp file will not be read by XIOS. Now deactivate albedo for XIOS.
+       CALL xios_orchidee_set_file_attr("reftemp_file",enabled=.FALSE.)
+       CALL xios_orchidee_set_field_attr("reftemp_interp",enabled=.FALSE.)
+    ENDIF
+
+  END SUBROUTINE thermosoil_xios_initialize
+
+  !!  =============================================================================================================================
+  !! 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','','')
+    ! Initialization to zero used at first time step in thermosoil_energy_diag, only for diagnostic variables coldcont_incr and surfheat_incr
+    pcapa_en(:,:) = 0.
+
+    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','','')
+       ! Initialization to zero used at first time step only for diagnostic output. 
+       ! This variable is only used in thermosoil_readajust and always calculated before in thermosoil_getdiff.
+       pcappa_supp(:,:) = 0.
+    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_readadjust called from thermosoil_coef)
+    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
+    REAL(r_std),DIMENSION (kjpindex)                      :: snowtemp_weighted!! Snow temperature weighted by snow density, only for diag (K)
+    REAL(r_std),DIMENSION (kjpindex, nsnow)               :: pkappa_snow_diag !! Only for diag, containing xios_default_val
+    REAL(r_std),DIMENSION (kjpindex, nsnow)               :: pcapa_snow_diag  !! Only for diag, containing xios_default_val
+    REAL(r_std),DIMENSION (kjpindex, nsnow)               :: snowtemp_diag    !! Only for diag, containing xios_default_val
+
+!_ ================================================================================================================================
+    
+  !! 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.
+  !!    cgrnd and dgrnd have been calculated in thermosoil_coef at the previous time step 
+  !!    but they are correct for the actual time-step.
+    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_diag for calculation of diagnostic variables
+    CALL thermosoil_energy_diag(kjpindex, temp_sol_new, soilcap)
+
+  !! Save ptn at current stage, to be used in thermosoil_readjust
+    ptn_beg(:,:) = ptn(:,:)
+
+  !! 6. Writing the history files according to the ALMA standards (or not..)
+
+    ! Add XIOS default value where no snow
+    DO ji=1,kjpindex 
+       IF (snow(ji) .GT. zero) THEN
+          pkappa_snow_diag(ji,:) = pkappa_snow(ji,:)
+          pcapa_snow_diag(ji,:) = pcapa_snow(ji,:)
+          snowtemp_diag(ji,:) = snowtemp(ji,:)
+       ELSE
+          pkappa_snow_diag(ji,:) = xios_default_val
+          pcapa_snow_diag(ji,:) = xios_default_val
+          snowtemp_diag(ji,:) = xios_default_val
+       END IF
+    END DO
+
+    DO ji=1,kjpindex 
+       ! Use min_sechiba instead of zero to avoid problem with division by zero
+       IF (snow(ji) .GT. min_sechiba) THEN
+          snowtemp_weighted(ji) = SUM(snowtemp(ji,:)*snowrho(ji,:))/SUM(snowrho(ji,:))
+       ELSE
+          snowtemp_weighted(ji) = xios_default_val
+       END IF
+    END DO
+    CALL xios_orchidee_send_field("snowtemp_weighted",snowtemp_weighted)
+     
+    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_diag)
+    CALL xios_orchidee_send_field("pcapa",pcapa)
+    CALL xios_orchidee_send_field("pcapa_snow",pcapa_snow_diag)
+    CALL xios_orchidee_send_field("snowtemp",snowtemp_diag)
+
+
+    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
+    REAL(r_std), DIMENSION (kjpindex)                      :: snowflxtot          !! Total snow flux (including snow on vegetated and bare soil and nobio areas)
+                                                                                  !! @tex ($W m^{-2}$) @endtex
+                                                                                  !! positive towards the soil
+
+!_ ================================================================================================================================
+
+  !! 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
+
+    ! Total snow flux (including snow on vegetated and bare soil and nobio areas)
+    DO ji = 1, kjpindex
+    	snowflxtot(ji) = snowflx(ji)*frac_snow_veg(ji)*(1-totfrac_nobio(ji)) + &
+          soilflx_nosnow(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)
+    ENDDO
+    CALL xios_orchidee_send_field("snowflxtot",snowflxtot(:))
+
+    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           !! Kersten 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. Kersten 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
+          ! Eq 11 in Peters-Lidard et al., 1998
+          IF ( satratio(ji,jg) >  0.1 ) THEN
+            IF ((jst < 4 .AND. soil_classif == 'usda') .OR. (jst == 1 .AND. soil_classif == 'zobler') )  THEN
+                ! Coarse 
+                ake(ji,jg) = 0.7 * LOG10 (SATRATIO(ji,jg)) + 1.0
+            ELSE
+                ! Fine 
+                ake(ji,jg) = LOG10 (satratio(ji,jg)) + 1.0
+            ENDIF
+          ELSEIF ( satratio(ji,jg) >  0.05 .AND. satratio(ji,jg) <=  0.1 ) THEN
+            IF ((jst < 4 .AND. soil_classif == 'usda') .OR. (jst == 1 .AND. soil_classif == 'zobler') )  THEN
+                ! Coarse 
+                ake(ji,jg) = 0.7 * LOG10 (satratio(ji,jg)) + 1.0
+            ELSE
+                ! Fine 
+                ake(ji,jg) = 0.0
+            ENDIF
+          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)/dlt(nslm) *dlt(jd)
+       ENDDO
+    ENDDO
+
+    IF (printlev >= 4) WRITE(numout,*) 'thermosoil_humlev done' 
+
+  END SUBROUTINE thermosoil_humlev
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_energy_diag
+!!
+!>\BRIEF         Calculate diagnostics 
+!!
+!! DESCRIPTION  : Calculate diagnostic variables coldcont_incr and coldcont_incr
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_energy_diag(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
+    
+    ! Save temp_sol_new to be used at next timestep
+    temp_sol_beg(:)   = temp_sol_new(:)
+
+  END SUBROUTINE thermosoil_energy_diag
+
+
+
+!! ================================================================================================================================
+!! 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)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pcapa_spec !! SPECIFIC soil heat capacity (J/kg/K)
+    REAL(r_std)                                         :: rho_tot    !! Soil density (kg/m3)
+
+    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) * (1-mcs(jst)) + water_capa * tmc_layt(ji,jg)/mille/dlt(jg)
+         !
+         ! 2. Calculate volumetric heat capacity with allowance for permafrost
+         ! 2.1. soil heat capacity depending on temperature and humidity
+         ! For SP6MIP we also diagnose a specific heat capacity (pcapa_spec), 
+         ! which requires to calculate the total density of the soil (rho_tot), always >> 0
+	 
+         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) * (1-mcs(jst)) + so_capa_ice * tmc_layt(ji,jg) / mille / dlt(jg)
+            rho_tot = rho_soil * (1-mcs(jst)) + rho_ice * tmc_layt(ji,jg) / mille / dlt(jg) 
+            pcapa_spec(ji, jg) = pcapa(ji, jg) / rho_tot
+
+     	 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.
+            rho_tot = rho_soil * (1-mcs(jst)) + rho_water * tmc_layt(ji,jg)/mille/dlt(jg)
+            pcapa_spec(ji, jg) = pcapa(ji, jg) / rho_tot
+     	 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
+    	   IF (ok_freeze_thaw_latent_heat) THEN
+              pcapa(ji, jg) = so_capa_dry_ns(jst) * (1-mcs(jst)) + &
+                water_capa * tmc_layt(ji,jg)/mille / dlt(jg) * xx + &
+                so_capa_ice * tmc_layt(ji,jg) / mille/dlt(jg) * (1.-xx) + &
+                shum_ngrnd_perma(ji,jg)*poros*lhf*rho_water/fr_dT
+	   ELSE
+              pcapa(ji, jg) = so_capa_dry_ns(jst) * (1-mcs(jst)) + &
+                water_capa * tmc_layt(ji,jg)/mille / dlt(jg) * xx + &
+                so_capa_ice * tmc_layt(ji,jg) / mille/dlt(jg) * (1.-xx)
+           ENDIF
+
+           rho_tot =  rho_soil* (1-mcs(jst)) + &
+                rho_water * tmc_layt(ji,jg)/mille / dlt(jg) * xx + &
+                rho_ice * tmc_layt(ji,jg) / mille/dlt(jg) * (1.-xx)
+           pcapa_spec(ji, jg) = pcapa(ji, jg) / rho_tot
+
+ 	   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 
+
+    ! Output the specific heat capcaity for SP-MIP
+    CALL xios_orchidee_send_field("pcapa_spec",pcapa_spec)
+
+    !
+    ! 3. Calculate the heat conductivity with allowance for permafrost
+    !
+    IF (ok_freeze_thaw_latent_heat) THEN
+    	CALL thermosoil_cond (kjpindex, njsc, mc_layt, QZ, SMCMAX, mcl_layt*(1-profil_froz), pkappa)
+    ELSE
+    	CALL thermosoil_cond (kjpindex, njsc, mc_layt, QZ, SMCMAX, mcl_layt, pkappa)
+    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
+
+
+!! ================================================================================================================================
+!! 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) * (1-mcs(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 >= 1) WRITE(numout,*) "thermosoil_read_reftempfile: Read and interpolate file " &
+         // TRIM(filename) //" for variable " //TRIM(variablename)
+
+    IF (xios_interpolation) THEN
+
+       CALL xios_orchidee_recv_field('reftemp_interp',reftemp(:,1))
+
+       DO ib=1, kjpindex
+           reftemp(ib,:) = reftemp(ib,1) + ZeroCelsius 
+       END DO
+       areftemp = 1.0
+    ELSE
+
+
+       ! 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
+
+    END IF
+
+    ! Write diagnostics
+    CALL xios_orchidee_send_field("areftemp",areftemp)
+    
+  END SUBROUTINE thermosoil_read_reftempfile
+
+END MODULE thermosoil
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/AA_make
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/AA_make	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/AA_make	(revision 8430)
@@ -0,0 +1,215 @@
+#-
+#- $Id$
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+MODS1 = stomate_data.f90      \
+        lpj_constraints.f90        \
+        lpj_cover.f90              \
+        lpj_crown.f90              \
+        lpj_establish.f90          \
+        lpj_fire.f90               \
+        lpj_gap.f90                \
+        lpj_kill.f90               \
+        lpj_light.f90              \
+        lpj_pftinout.f90           \
+        stomate_alloc.f90          \
+        stomate_data.f90           \
+        stomate_io.f90             \
+        stomate_litter.f90         \
+        stomate_npp.f90            \
+        stomate_phenology.f90      \
+        stomate_prescribe.f90      \
+        stomate_season.f90         \
+        stomate_soilcarbon.f90     \
+        stomate_turnover.f90       \
+        stomate_vmax.f90           \
+        stomate_lcchange.f90       \
+        stomate_lpj.f90            \
+        stomate_resp.f90           \
+        stomate.f90
+
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) liborglob
+	$(M_K) m_all
+	@echo stomate is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+memory:
+#-Q- sxnec 	@echo maximum memory must be defined on Rhodes 
+#-Q- sxnec 	@echo in sh or ksh : ulimit -v unlimited 
+#-Q- sxnec 	@echo in csh or tcsh : limit vmemoryuse unlimited 
+#-Q- sxnec 	-/sbin/ulimit -v unlimited
+#-Q- sxnec 	-limit vmemoryuse unlimited
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+liborglob:
+	(cd ../src_global; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD:
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+config: 
+	$(BINDIR)/Fparser -name STOMATE $(MODS1)
+	echo 'Configuration of STOMATE done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(stomate.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(stomate_io.o)      \
+  $(MODEL_LIB)(stomate_lpj.o)
+
+$(MODEL_LIB)(stomate_data.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(PARAM_LIB)(constantes.o)  
+
+$(MODEL_LIB)(lpj_constraints.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_cover.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_crown.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_establish.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_fire.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_gap.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_kill.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_light.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_pftinout.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_alloc.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_io.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(PARALLEL_LIB)(mod_orchidee_para.o)
+
+
+$(MODEL_LIB)(stomate_litter.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_npp.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_phenology.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_prescribe.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_resp.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_season.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_soilcarbon.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(ORGLOB_LIB)(grid.o)\
+  $(ORGLOB_LIB)(solar.o)
+
+$(MODEL_LIB)(stomate_turnover.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_vmax.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_lcchange.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_lpj.o):            \
+  $(MODEL_LIB)(lpj_constraints.o)       \
+  $(MODEL_LIB)(lpj_cover.o)             \
+  $(MODEL_LIB)(lpj_crown.o)             \
+  $(MODEL_LIB)(lpj_establish.o)         \
+  $(MODEL_LIB)(lpj_fire.o)              \
+  $(MODEL_LIB)(lpj_gap.o)               \
+  $(MODEL_LIB)(lpj_kill.o)              \
+  $(MODEL_LIB)(lpj_light.o)             \
+  $(MODEL_LIB)(lpj_pftinout.o)          \
+  $(MODEL_LIB)(stomate_alloc.o)         \
+  $(MODEL_LIB)(stomate_data.o)          \
+  $(MODEL_LIB)(stomate_litter.o)        \
+  $(MODEL_LIB)(stomate_npp.o)           \
+  $(MODEL_LIB)(stomate_phenology.o)     \
+  $(MODEL_LIB)(stomate_prescribe.o)     \
+  $(MODEL_LIB)(stomate_season.o)        \
+  $(MODEL_LIB)(stomate_soilcarbon.o)    \
+  $(MODEL_LIB)(stomate_turnover.o)      \
+  $(MODEL_LIB)(stomate_vmax.o)          \
+  $(MODEL_LIB)(stomate_resp.o)          \
+  $(MODEL_LIB)(stomate_lcchange.o)
+
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/AA_make.ldef	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/AA_make.ldef	(revision 8430)
@@ -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-AFP/src_stomate/lpj_constraints.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_constraints.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_constraints.f90	(revision 8430)
@@ -0,0 +1,248 @@
+! =================================================================================================================================
+! MODULE       : lpj_constraints
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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         !! plant adaptation to climate: progressively decrease if temperature is too low
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: regenerate      !! plant regeneration: if vernalization criteria is not reached (i.e not allow
+                                                                       !! plant to correctly seed and reproduce) then regeneration progressively decrease
+
+    !! 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
+       IF (printlev >= 2) 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
+       END IF
+       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 gro_limit degree (grow_limit) for trees to be declared adapted.
+          IF ( is_tree(j) ) THEN
+             WHERE ( Tseason(:) .LT. grow_limit )
+                adapted(:,j)=zero
+             ENDWHERE
+          ENDIF
+          ! if Tseason was less than grow_limit from previous year then the adataption decrease
+          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
+             ! if the vernalization is reach, the plant flowering will be correct and then the production of seed
+             ! will be correct, making the plant able to reproduce and regenerate (i.e fitness)
+             WHERE ( t2m_month(:) .LE. tcm_crit(j) )
+                regenerate(:,j) = un
+             ENDWHERE
+
+             ! each time vernalization is not reached, the fitness decrease
+             !  hence, with time ::regenerate approaches 0
+             regenerate(:,j) = regenerate(:,j) * (tau_regenerate-dt)/tau_regenerate
+
+          ENDIF
+
+          !! 2.1.4 
+          !        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 natural 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-AFP/src_stomate/lpj_cover.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_cover.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_cover.f90	(revision 8430)
@@ -0,0 +1,307 @@
+! =================================================================================================================================
+! MODULE       : lpj_cover
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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_cov_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_cov_max (i.e. delta_veg)
+!! Grid-scale fpc (foliage projected coverage) is calculated to obtain the shadede ground area by leaf's light capture
+!! Finally, grid-scale fpc is adjusted not to exceed 1.0
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::lai (leaf area index, @tex $(m^2 m^{-2})$ @endtex), 
+!! :: veget (fractional vegetation cover, unitless)
+!!
+!! REFERENCE(S)   : None
+!! 
+!! FLOWCHART :
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{lpj_cover_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE cover (npts, cn_ind, ind, biomass, &
+       veget_cov_max, veget_cov_max_old, lai, litter, carbon, turnover_daily, bm_to_litter, &
+       co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, gpp_daily)
+
+!! 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_cov_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), INTENT(inout)            :: carbon         !! 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_cov_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
+
+    !! 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)                          :: dilu_soil_carbon    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_bio            !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_TCarbon        !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_turnover_daily !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_bm_to_litter   !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2flux_new    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_gpp_daily      !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_growth    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_maint     !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_hetero    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2_to_bm      !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2_fire       !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nvm)                            :: TCarbon             !! Total carbon
+    REAL(r_std), DIMENSION(npts,nvm)                            :: co2flux_new         !! NBP after re-calculation in order to conserve carbon 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: co2flux_old         !! NBP before re-calculation 
+    REAL(r_std), DIMENSION(nvm)                                 :: delta_veg           !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(nvm)                                 :: reduct              !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: delta_veg_sum       !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: diff                !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: sr                  !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: frac_nat            !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: sum_vegettree       !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: sum_vegetgrass      !! Conversion factors (unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: sum_veget_natveg    !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: vartmp              !! Temporary variable used to add history
+
+!_ ================================================================================================================================
+
+ !! 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_cov_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_cov_max(:,j) = ind(:,j) * cn_ind(:,j)
+             sum_veget_natveg(:) = sum_veget_natveg(:) + veget_cov_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_cov_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_cov_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_cov_max(i,j) =  veget_cov_max(i,j) * frac_nat(i) / sum_veget_natveg(i)
+                ENDIF
+             ENDDO ! loop over PFTs
+
+          ENDIF
+       ENDDO ! loop over grid points
+	
+       ! Renew veget_cov_max of bare soil as 0 to difference of veget_cov_max (ibare_sechiba) 
+       ! to current veget_cov_max
+       DO j = 2,nvm ! loop over PFTs
+          veget_cov_max(:,ibare_sechiba) = veget_cov_max(:,ibare_sechiba) - veget_cov_max(:,j)
+       ENDDO ! loop over PFTs
+       veget_cov_max(:,ibare_sechiba) = MAX( veget_cov_max(:,ibare_sechiba), zero )
+
+       !! 1.2 Calculate carbon fluxes between PFTs to maintain mass balance
+       !! Assure carbon closure when veget_cov_max changes(delta_veg): if veget_cov_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_cov_max.
+       DO i = 1, npts ! loop over grid points
+          
+          ! Calculate the change in veget_cov_max between previous time step and current time step
+          delta_veg(:) = veget_cov_max(i,:)-veget_cov_max_old(i,:)
+          delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.zero)
+
+          dilu_lit(i,:,:,:) = zero
+          dilu_soil_carbon(i,:) = zero
+          dilu_bio(i,:,:) = zero
+          dilu_TCarbon(i)=zero
+          dilu_turnover_daily(i,:,:)=zero
+          dilu_bm_to_litter(i,:,:)=zero
+          dilu_co2flux_new(i)=zero
+          dilu_gpp_daily(i)=zero
+          dilu_resp_growth(i)=zero
+          dilu_resp_maint(i)=zero
+          dilu_resp_hetero(i)=zero
+          dilu_co2_to_bm(i)=zero
+          dilu_co2_fire(i)=zero
+
+          ! Calculate TCarbon: total carbon including biomass, litter and soil carbon, as well as "today's" turnover and 
+          ! bm_to_litter due to mortality, because today's turnover and bm_to_litter are not yet added into "litter" until tomorrow. 
+          DO j=1, nvm
+                TCarbon(i,j)=SUM(biomass(i,j,:,:))+SUM(carbon(i,:,j))+SUM(litter(i,:,j,:,:))+&
+                     SUM(turnover_daily(i,j,:,:))+SUM(bm_to_litter(i,j,:,:))
+                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_soil_carbon(i,:) =  dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / 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_cov_max (delta_veg)
+                ! Litter
+                litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_cov_max_old(i,j) + dilu_lit(i,:,:,:) * delta_veg(j)) &
+                                  / veget_cov_max(i,j)
+
+                ! Soil carbon
+                carbon(i,:,j)=(carbon(i,:,j) * veget_cov_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_cov_max(i,j)
+                TCarbon(i,j)=(TCarbon(i,j) * veget_cov_max_old(i,j) + dilu_TCarbon(i) * delta_veg(j)) / veget_cov_max(i,j)
+                turnover_daily(i,j,:,:)=(turnover_daily(i,j,:,:)*veget_cov_max_old(i,j)+&
+                     dilu_turnover_daily(i,:,:)*delta_veg(j))/veget_cov_max(i,j)
+                bm_to_litter(i,j,:,:)=(bm_to_litter(i,j,:,:)*veget_cov_max_old(i,j)+&
+                     dilu_bm_to_litter(i,:,:)*delta_veg(j))/veget_cov_max(i,j)
+                co2flux_new(i,j)=(co2flux_old(i,j)*veget_cov_max_old(i,j)+dilu_co2flux_new(i)*delta_veg(j))/veget_cov_max(i,j)
+                gpp_daily(i,j)=(gpp_daily(i,j)*veget_cov_max_old(i,j)+dilu_gpp_daily(i)*delta_veg(j))/veget_cov_max(i,j)
+                resp_growth(i,j)=(resp_growth(i,j)*veget_cov_max_old(i,j)+dilu_resp_growth(i)*delta_veg(j))/veget_cov_max(i,j)
+                resp_maint(i,j)=(resp_maint(i,j)*veget_cov_max_old(i,j)+dilu_resp_maint(i)*delta_veg(j))/veget_cov_max(i,j)
+                resp_hetero(i,j)=(resp_hetero(i,j)*veget_cov_max_old(i,j)+dilu_resp_hetero(i)*delta_veg(j))/veget_cov_max(i,j)
+                co2_to_bm(i,j)=(co2_to_bm(i,j)*veget_cov_max_old(i,j)+dilu_co2_to_bm(i)*delta_veg(j))/veget_cov_max(i,j)
+                co2_fire(i,j)=(co2_fire(i,j)*veget_cov_max_old(i,j)+dilu_co2_fire(i)*delta_veg(j))/veget_cov_max(i,j)
+             ENDIF
+
+             IF(veget_cov_max(i,j).GT.min_stomate) THEN
+
+                ! Correct biomass densities to conserve mass
+                ! since it's defined on veget_cov_max
+                biomass(i,j,:,:) = biomass(i,j,:,:) * veget_cov_max_old(i,j) / veget_cov_max(i,j)
+
+             ENDIF
+
+          ENDDO ! loop over PFTs
+       ENDDO ! loop over grid points
+
+       vartmp(:)=SUM(gpp_daily*veget_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tGPP", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_growth*veget_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_GROWTH", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_maint*veget_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_MAINT", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_hetero*veget_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_HETERO", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_to_bm*veget_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2_TAKEN", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_fire*veget_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2_FIRE", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2flux_new*veget_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2FLUX", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2flux_old*veget_cov_max_old,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2FLUX_OLD", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(TCarbon*veget_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCARBON", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(SUM(biomass(:,:,:,icarbon),dim=3)*veget_cov_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_cov_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tLITTER", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(SUM(carbon,dim=2)*veget_cov_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-AFP/src_stomate/lpj_crown.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_crown.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_crown.f90	(revision 8430)
@@ -0,0 +1,203 @@
+! =================================================================================================================================
+! MODULE       : lpj_crown
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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_cov_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_cov_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_cov_max/ind, not as stated here, correction MERGE 
+                !!         woodmass(:) = &
+                !! &         (biomass(:,j,isapabove,icarbon) + biomass(:,j,isapbelow,icarbon) &
+                !! &         +biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon))/ind(:,j)
+          
+                !! 2.1.1.2 Stem diameter from pipe model
+                !          Stem diameter (pipe model) is calculated by allometory (eqn 1, Appdx B, Smith et al. (2001))
+                !!!$          dia(:) = (woodmass(:)/(pipe_density*pi/4.*pipe_tune2)) &
+                dia(:) = (woodmass_ind(:,j)/(pipe_density*pi/4.*pipe_tune2)) &
+                 &       **(1./(2.+pipe_tune3))
+
+                !! 2.1.1.3 Individual tree height from pipe model
+                !          Individual tree height (eqn 2, Appdx B, Smith et al. (2001))
+                height(:,j) = pipe_tune2*(dia(:)**pipe_tune3)
+
+                !!!$S. Zaehle : The constraint on height has nothing to do with LPJ (for that purpose there's dia_max
+                !!!$ cannot see why this is necessary - it also blurrs the output, hence I leave it commented
+                !!!$ WHERE (height(:,j) > height_presc_12(j))
+                !!!$    dia(:) = (height_presc_12(j)/pipe_tune2)**(1./pipe_tune3)
+                !!!$    height(:,j) = height_presc_12(j)
+                !!!$ ENDWHERE
+
+                !! 2.1.1.4 Crown area of individual tree  
+                !          Calculate crown area, truncate crown area for trunks with large diameters 
+                ! crown area cannot exceed a certain value, prescribed through maxdia 
+                ! (eqn 3, Appdx B, Smith et al. (2001))
+                cn_ind(:,j) = pipe_tune1*MIN(dia(:),maxdia(j))**pipe_tune_exp_coeff
+
+             ENDWHERE
+          ELSE
+
+             !! 2.1.2 Agricultural tree
+             !        To be developped if needed
+             CALL ipslerr_p(3,'crown','Cannot treat agricultural trees.','','')
+          ENDIF
+       ELSE
+          
+       !! 2.2 Grasses
+          
+          WHERE (PFTpresent(:,j))
+
+             !! 2.2.1 Crown area of grass
+             !        An "individual" is 1 m^2 of grass
+             cn_ind(:,j) = un
+          ENDWHERE
+       ENDIF
+       
+       !! 2.3 Recalculate vegetation cover 
+       
+       !!!$S. Zaehle : since now all state variables are defined on veget_cov_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_cov_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_cov_max(:,j) = ind(:,j) * cn_ind(:,j)
+       !!!$ ENDIF
+
+    ENDDO ! loop over PFTs
+
+  END SUBROUTINE crown
+
+END MODULE lpj_crown
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_establish.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_establish.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_establish.f90	(revision 8430)
@@ -0,0 +1,803 @@
+! =================================================================================================================================
+! MODULE       : lpj_establish
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC establish,establish_clear
+
+  LOGICAL, SAVE                          :: firstcall_establish = .TRUE.           !! first call
+!$OMP THREADPRIVATE(firstcall_establish)
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : fire_clear 
+!!
+!>\BRIEF       Set the firstcall_establish flag to .TRUE. and activate initialization
+!_ ================================================================================================================================
+
+  SUBROUTINE establish_clear
+    firstcall_establish = .TRUE.
+  END SUBROUTINE establish_clear
+
+
+! =================================================================================================================================
+! SUBROUTINE   : establish 
+!
+!>\BRIEF       Calculate sstablishment of new woody PFT and herbaceous PFTs
+!!
+!! DESCRIPTION : Establishments of new woody and herbaceous PFT are simulated. 
+!! Maximum establishment rate (0.12) declines due to competition for light (space).
+!! There are two establishment estimates: one for the for DGVM and one for the 
+!! static cases.\n
+!! In the case of DGVM, competitive process of establishment for the area of 
+!! available space is represented using more detailed description compared with static 
+!! one. Biomass and distribution of plant age are updated on the basis of changes 
+!! in number of individuals. Finally excess sapwood of is converted to heartwood.
+!!
+!! \latexonly
+!! \input{equation_lpj_establish.tex}
+!! \endlatexonly
+!! \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)    :
+!! Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!    dynamics in the modelling of terrestrial ecosystems: comparing two
+!!    contrasting approaches within European climate space,
+!!    Global Ecology and Biogeography, 10, 621-637.
+!!
+!! FLOWCHART       : 
+!! \latexonly
+!! \includegraphics[scale = 0.7]{establish.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE establish (npts, dt, PFTpresent, regenerate, &
+       neighbours, resolution, need_adjacent, herbivores, &
+       precip_annual, gdd0, lm_lastyearmax, &
+       cn_ind, lai, avail_tree, avail_grass,  npp_longterm, &
+       leaf_age, leaf_frac, &
+       ind, biomass, age, everywhere, co2_to_bm,veget_cov_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,nvm), INTENT(in)              :: lai             !! leaf area index OF an individual plant 
+                                                                                 !! (m^2 m^{-2})           
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: avail_tree      !! space availability for trees (unitless)     
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: avail_grass     !! space availability for grasses (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: npp_longterm    !! longterm NPP, for each PFT (gC m^{-2})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_cov_max   !! "maximal" coverage fraction of a PFT 
+                                                                                 !! (LAI -> infinity) on ground (unitless)
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)               :: mortality       !! Fraction of individual dying this time 
+                                                                                 !! step (0 to 1, unitless) 
+
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! leaf age (days)     
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! fraction of leaves in leaf age class (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Number of individuals (individuals m^{-2})          
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass   !! biomass (gC m^{-2 })     
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! mean age (years)       
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very 
+                                                                                 !! localized (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! biomass up take for establishment i.e. 
+                                                                                 !! pseudo-photosynthesis (gC m^{-2} day^{-1}) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: woodmass_ind    !! woodmass of the individual, needed to calculate
+                                                                                 !! crownarea in lpj_crownarea (gC m^{-2 })  
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !!Biomass transfer to litter
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                               :: tau_eatup       !! time during which a sapling can be entirely 
+                                                                                 !! eaten by herbivores (days) 
+    REAL(r_std), DIMENSION(npts,nvm)                          :: fpc_nat         !! new fpc, foliage projective cover: fractional
+                                                                                 !! coverage (unitless)       
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_climate_tree  !! maximum tree establishment rate, 
+                                                                                              !! based on climate only (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_climate_grass !! maximum grass establishment rate,
+                                                                                              !! based on climate only (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_tree          !! maximum tree establishment rate, 
+                                                                                              !! based on climate and fpc 
+                                                                                              !! (unitless) 
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_grass         !! maximum grass establishment rate,
+                                                                                              !! based on climate and fpc 
+                                                                                              !! (unitless) 
+    REAL(r_std), DIMENSION(npts)                              :: sumfpc          !! total natural fpc (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: fracnat         !! total fraction occupied by natural 
+                                                                                 !! vegetation (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: sumfpc_wood     !! total woody fpc (unitless)    
+    REAL(r_std), DIMENSION(npts)                              :: spacefight_grass!! for grasses, measures the total concurrence 
+                                                                                 !! for available space (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                          :: d_ind           !! change in number of individuals per time step 
+                                                                                 !! (individuals m^{-2} day{-1})         
+    REAL(r_std), DIMENSION(npts)                              :: bm_new          !! biomass increase (gC m^{-2 })        
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)         :: biomass_old     !! Save the original biomass passed into the subroutine 
+    REAL(r_std), DIMENSION(npts)                              :: bm_non          !! Non-effective establishment: the "virtual" saplings that die instantly
+    REAL(r_std), DIMENSION(npts)                              :: bm_eff          !! Effective (or real) establishment  
+    REAL(r_std), DIMENSION(npts)                              :: dia             !! stem diameter (m)    
+    REAL(r_std), DIMENSION(npts)                              :: b1              !! temporary variable           
+    REAL(r_std), DIMENSION(npts)                              :: woodmass        !! woodmass of an individual (gC m^{-2})  
+    REAL(r_std), DIMENSION(npts)                              :: leaf_mass_young !! carbon mass in youngest leaf age class 
+                                                                                 !! (gC m^{-2})
+    REAL(r_std), DIMENSION(npts)                              :: factor          !! reduction factor for establishment if many 
+                                                                                 !! trees or grasses are present (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: total_bm_c      !! Total carbon mass for all pools (gC m^{-2})    
+    REAL(r_std), DIMENSION(npts,nelements)                    :: total_bm_sapl   !! Total sappling biomass for all pools 
+                                                                                 !! (gC m^{-2})  
+    REAL(r_std), DIMENSION(npts,nelements)                    :: total_bm_sapl_non !! total non-effective sapling biomass 
+
+    INTEGER(i_std)                                            :: nfrontx         !! from how many sides is the grid box invaded
+                                                                                 !! (unitless?)   
+    INTEGER(i_std)                                            :: nfronty         !! from how many sides is the grid box invaded
+                                                                                 !! (unitless?)   
+    REAL(r_std), DIMENSION(npts)                              :: vn              !! flow due to new individuals veget_cov_max after 
+                                                                                 !! establishment, to get a proper estimate of 
+                                                                                 !! carbon and nitrogen 
+    REAL(r_std), DIMENSION(npts)                              :: lai_ind         !! lai on each PFT surface (m^2 m^{-2})   
+    REAL(r_std), DIMENSION(npts)                              :: veget_cov_max_tree  !! Sum of veget_cov_max for the pft's which are trees
+    INTEGER(i_std)                                            :: nbtree          !! Number of PFT's which are trees
+    INTEGER(i_std)                                            :: i,j,k,m         !! indices (unitless)       
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering establish'
+
+  !! 1. messages and initialization
+
+    ! time during which young plants can be completely eaten by herbivores after germination
+    ! (and then individual die) assume to be 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_cov_max_tree(:) = 0.0
+    nbtree=0
+    DO j = 1, nvm 
+       IF (is_tree(j)) THEN
+          veget_cov_max_tree(:) = veget_cov_max_tree(:) + veget_cov_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_cov_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_cov_max(:,j)
+          ENDIF
+       ENDDO ! Loop over # PFTs
+       
+       sumfpc(:) = zero
+
+       !! 2.2 Total natural fpc on grid
+       !      The overall fractional coverage of a PFT in a grid is calculated here.
+       !      FPC is related to mean individual leaf area index by the Lambert-Beer law.
+       !      See Eq. (1) in tex file.\n
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( natural(j) ) THEN
+             WHERE(fracnat(:).GT.min_stomate)
+                WHERE (lai(:,j) == val_exp) 
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ELSEWHERE
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                        * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                ENDWHERE
+             ENDWHERE
+
+             WHERE ( PFTpresent(:,j) )
+                sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
+             ENDWHERE
+          ELSE
+
+             fpc_nat(:,j) = zero
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+       
+       !! 2.3 Total woody fpc on grid and number of regenerative tree pfts
+       !      Total woody FPC increases by adding new FPC.
+       !      Under the condition that temperature in last winter is higher than a threshold, 
+       !      woody plants is exposed in higher competitive environment.
+       sumfpc_wood(:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( is_tree(j) .AND. natural(j) ) THEN
+
+             ! total woody fpc
+             WHERE ( PFTpresent(:,j) )
+                sumfpc_wood(:) = sumfpc_wood(:) + fpc_nat(:,j)
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+       !! 2.4 Total number of natural grasses on grid\n
+       !     Grass increment equals 'everywhere'\n
+       spacefight_grass(:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( .NOT. is_tree(j) .AND. natural(j) ) THEN
+
+             ! Count a PFT fully only if it is present on a grid.
+             WHERE ( PFTpresent(:,j) )
+                spacefight_grass(:) = spacefight_grass(:) + everywhere(:,j)
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+       !! 2.5 Maximum establishment rate, based on climate only\n
+       WHERE ( ( precip_annual(:) .GE. precip_crit ) .AND. ( gdd0(:) .GE. gdd_crit_estab ) )
+
+          estab_rate_max_climate_tree(:) = estab_max_tree ! 'estab_max_*'; see 'stomate_constants.f90'
+          estab_rate_max_climate_grass(:) = estab_max_grass
+
+       ELSEWHERE
+
+          estab_rate_max_climate_tree(:) = zero
+          estab_rate_max_climate_grass(:) = zero
+
+       ENDWHERE
+
+       !! 2.6 Reduce maximum tree establishment rate if many trees are present.
+       !      In the original DGVM, this is done using a step function which yields a
+       !      reduction by factor 4 if sumfpc_wood(i) .GT.  fpc_crit - 0.05.
+       !      This can lead to small oscillations (without consequences however).
+       !      Here, a steady linear transition is used between fpc_crit-0.075 and
+       !      fpc_crit-0.025.
+       !      factor(:) = 1. - 15. * ( sumfpc_wood(:) - (fpc_crit-.075))
+       !      factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:)))
+       !      S. Zaehle modified according to Smith et al. 2001
+       !      See Eq. (2) in header
+       factor(:)=(un - exp(- establish_scal_fact * (un - sumfpc_wood(:))))*(un - sumfpc_wood(:))
+       estab_rate_max_tree(:) = estab_rate_max_climate_tree(:) * factor(:)
+
+       !! 2.7 Modulate grass establishment rate.
+       !      If canopy is not closed (fpc < fpc_crit-0.05), normal establishment.
+       !      If canopy is closed, establishment is reduced by a factor 4.
+       !      Factor is linear between these two bounds.
+       !      This is different from the original DGVM where a step function is
+       !      used at fpc_crit-0.05 (This can lead to small oscillations,
+       !      without consequences however).
+       !      factor(:) = 1. - 15. * ( sumfpc(:) - (fpc_crit-.05))
+       !      factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:)))
+       !      estab_rate_max_grass(:) = estab_rate_max_climate_grass(:) * factor(:)
+       !      S. Zaehle modified to true LPJ formulation, grasses are only allowed in the
+       !      fpc fraction not occupied by trees..., 080806
+       !      estab_rate_max_grass(:)=MAX(0.98-sumfpc(:),zero)
+       !      See Eq. (3) in header
+       estab_rate_max_grass(:) = MAX(MIN(estab_rate_max_climate_grass(:), max_tree_coverage - sumfpc(:)),zero)
+
+       !! 2.8 Longterm grass NPP for competition between C4 and C3 grasses
+       !      to avoid equal veget_cov_max, the idea is that more reestablishment
+       !      is possible for the more productive PFT
+       factor(:) = min_stomate
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( natural(j) .AND. .NOT.is_tree(j)) & 
+               factor(:) = factor(:) + npp_longterm(:,j) * &
+               lm_lastyearmax(:,j) * sla(j)
+       ENDDO ! Loop over # PFTs
+
+       !! 2.9 Establish natural PFTs
+       d_ind(:,:) = zero
+
+       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)*lm_lastyearmax(:,j)*sla(j)/factor(:)) * fracnat(:) * dt/one_year
+                ENDWHERE
+                
+             ENDIF  ! tree/grass
+             
+          ENDIF ! if natural
+       ENDDO  ! Loop over # PFTs
+       
+  !! 3. Lpj establishment in static case 
+
+    !     Lpj establishment in static case, S. Zaehle 080806, account for real LPJ dynamics in
+    !     prescribed vegetation, i.e. population dynamics within a given area of the grid cell.
+    ELSE 
+
+       d_ind(:,:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          WHERE(ind(:,j)*cn_ind(:,j).GT.min_stomate)
+             lai_ind(:) = sla(j) * lm_lastyearmax(:,j)/(ind(:,j)*cn_ind(:,j))
+          ELSEWHERE
+             lai_ind(:) = zero
+          ENDWHERE
+
+          !! 3.1 For natural woody PFTs
+          IF ( natural(j) .AND. is_tree(j)) THEN 
+
+             ! See Eq. (4) in tex file.            
+             fpc_nat(:,j) =  MIN(un, cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) )
+
+
+             WHERE (veget_cov_max(:,j).GT.min_stomate.AND.ind(:,j).LE.2.)
+
+                !! 3.1.1 Only establish into growing stands 
+                !        Only establish into growing stands, ind can become very
+                !        large in the static mode because LAI is very low in poor 
+                !        growing conditions, favouring continuous establishment. 
+                !        To avoid this a maximum IND is set. BLARPP: This should be
+                !        replaced by a better stand density criteria.
+                factor(:)=(un - exp(-establish_scal_fact * (un - fpc_nat(:,j))))*(un - fpc_nat(:,j))
+
+                estab_rate_max_tree(:) = estab_max_tree * factor(:) 
+
+                !! 3.1.2 do establishment for natural PFTs\n
+                d_ind(:,j) = MAX( zero, estab_rate_max_tree(:) * dt/one_year)
+
+             ENDWHERE
+
+             !S. Zaehle: quickfix: to simulate even aged stand, uncomment the following lines...
+             !where (ind(:,j) .LE. min_stomate)
+             !d_ind(:,j) = 0.1 !MAX( 0.0, estab_rate_max_tree(:) * dt/one_year)
+             WHERE (veget_cov_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_cov_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_cov_max(:,j).GT.min_stomate .AND. ind(:,j).EQ. zero)
+                d_ind(:,j) = ind_0_estab 
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+    ENDIF ! DGVM OR NOT
+
+  !! 4. Biomass calculation
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN ! only for natural PFTs
+
+          !! 4.1 Herbivores reduce establishment rate
+          !      We suppose that saplings are vulnerable during a given time after establishment.
+          !      This is taken into account by preventively reducing the establishment rate.
+          IF ( ok_herbivores ) THEN
+
+             d_ind(:,j) = d_ind(:,j) * EXP( - tau_eatup/herbivores(:,j) )
+
+          ENDIF
+
+          !! 4.2 Total biomass.
+          !      Add biomass only if d_ind, over one year, is of the order of ind.
+          !      save old leaf mass to calculate leaf age
+          leaf_mass_young(:) = leaf_frac(:,j,1) * biomass(:,j,ileaf,icarbon)
+
+          ! total biomass of existing PFT to limit biomass added from establishment
+          total_bm_c(:) = zero
+
+          DO k = 1, nparts
+             total_bm_c(:) = total_bm_c(:) + biomass(:,j,k,icarbon)
+          ENDDO
+          IF(ok_dgvm) THEN
+             vn(:) = veget_cov_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_cov_max after establishment (needed for correct scaling!)
+             ! essential correction for MERGE!
+             IF(is_tree(j))THEN
+                DO i=1,npts ! Loop over # pixels - domain size
+                   IF((d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN
+
+                      IF((total_bm_c(i).LE.min_stomate) .OR. (veget_cov_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_cov_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_cov_max(i,j) &
+                              & /(ind(i,j) + d_ind(i,j))
+
+                      ENDIF
+
+                      ! new diameter of PFT
+                      dia(i) = (woodmass_ind(i,j)/(pipe_density*pi/4.*pipe_tune2)) &
+                           &                **(1./(2.+pipe_tune3))
+                      vn(i) = (ind(i,j) + d_ind(i,j))*pipe_tune1*MIN(dia(i),maxdia(j))**pipe_tune_exp_coeff
+
+                   ENDIF
+                ENDDO ! Loop over # pixels - domain size
+             ELSE ! for grasses, cnd=1, so the above calculation cancels
+                vn(:) = ind(:,j) + d_ind(:,j)
+             ENDIF
+
+          !! 4.3.2 without DGVM (static)\n
+          ELSE 
+             DO i=1,npts ! Loop over # pixels - domain size
+                IF(is_tree(j).AND.(d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN
+                   IF(total_bm_c(i).LE.min_stomate) THEN
+
+                      ! new wood mass of PFT
+                      woodmass_ind(i,j) = &
+                           & (((biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                           & + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))) &
+                           & + (bm_sapl(j,isapabove,icarbon) + bm_sapl(j,isapbelow,icarbon) &
+                           & + bm_sapl(j,iheartabove,icarbon) + bm_sapl(j,iheartbelow,icarbon))*d_ind(i,j))/(ind(i,j)+d_ind(i,j))
+
+                   ELSE
+ 
+                      ! new biomass is added to the labile pool, hence there is no change 
+                      ! in CA associated with establishment
+                      woodmass_ind(i,j) = &
+                           & (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                           & + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon)) &
+                           & /(ind(i,j) + d_ind(i,j))
+
+                   ENDIF
+                ENDIF
+             ENDDO ! Loop over # pixels - domain size
+
+             vn(:) = un ! cannot change in static!, and veget_cov_max implicit in d_ind
+
+          ENDIF
+
+          !! 4.4 total biomass of PFT added by establishment defined over veget_cov_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_c(:).GT.min_stomate.AND.veget_cov_max(:,j).GT.min_stomate)
+
+                total_bm_sapl(:,icarbon) = total_bm_sapl(:,icarbon) + bm_sapl(j,k,icarbon) * d_ind(:,j) / veget_cov_max(:,j)
+
+                ! 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) / veget_cov_max(:,j)
+
+             ENDWHERE
+          ENDDO ! Loop over # litter tissues
+
+!Dan Zhu modification: there is a problem here, if DGVM is activated, co2_to_bm will never reach
+!0 due to establishment, where d_ind is still large at equilibrium (=ind*mortality). So we
+!need to subtract it from litter (not biomass, because the
+!corresponding biomass has been lost in lpj_gap).
+
+          !! 4.5 Update biomass at each component
+          DO k = 1, nparts ! Loop over # litter tissues
+
+             bm_new(:) = zero
+             bm_non(:) = zero
+             bm_eff(:) = zero
+
+             ! first ever establishment, C flows
+             WHERE( d_ind(:,j).GT.min_stomate .AND. &
+                  total_bm_c(:).LE.min_stomate .AND. &
+                  veget_cov_max(:,j).GT.min_stomate)
+
+                bm_new(:) = d_ind(:,j) * bm_sapl(j,k,icarbon) / veget_cov_max(:,j)
+                biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_new(:)
+
+                ! bm_to_litter minus the 'non-effective' establishment (mortality), but cannot be less than 0
+                WHERE((veget_cov_max_tree(:) .GT. 0.1) .AND. (veget_cov_max(:,j) .LT. veget_cov_max_tree(:)/nbtree) )
+
+                   bm_non(:) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), &
+                        (ind(:,j)+d_ind(:,j))*mortality(:,j) * bm_sapl(j,k,icarbon)/veget_cov_max(:,j) )
+                   bm_eff(:) = MIN( npp_longterm(:,j)/one_year, bm_new(:)-bm_non(:) )
+                   bm_non(:) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), bm_new(:)-bm_eff(:) )
+
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:) - bm_non(:)
+                   WHERE( bm_to_litter(:,j,k,icarbon) .LT. bm_non(:) )
+                      biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - ( bm_non(:) - bm_to_litter(:,j,k,icarbon) )
+                   ENDWHERE
+                   bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) - MIN(bm_to_litter(:,j,k,icarbon), bm_non(:) )
+
+                ELSEWHERE
+
+                   bm_non(:) = MIN( bm_to_litter(:,j,k,icarbon), &
+                        (ind(:,j)+d_ind(:,j))*mortality(:,j) * bm_sapl(j,k,icarbon)/veget_cov_max(:,j) )
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:)/dt - bm_non(:)/dt
+                   bm_to_litter(:,j,k,icarbon)=bm_to_litter(:,j,k,icarbon)- bm_non(:)
+                ENDWHERE
+
+             ENDWHERE
+
+             ! establishment into existing population, C flows
+             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm_c(:).GT.min_stomate)
+
+                bm_new(:) = total_bm_sapl(:,icarbon) * biomass_old(:,j,k,icarbon) / total_bm_c(:)
+                biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_new(:)
+
+                WHERE((veget_cov_max_tree(:) .GT. 0.1) .AND. (veget_cov_max(:,j) .LT. veget_cov_max_tree(:)/nbtree) )
+                   bm_non(:) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), &
+                        total_bm_sapl_non(:,icarbon) *biomass_old(:,j,k,icarbon)/total_bm_c(:) )
+                   bm_eff(:) = MIN( npp_longterm(:,j)/one_year, bm_new(:)-bm_non(:) )
+                   bm_non(:) = MAX( zero, MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon)-min_stomate, &
+                        bm_new(:)-bm_eff(:) ) )
+
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:) - bm_non(:)
+                   WHERE( bm_to_litter(:,j,k,icarbon) .LT. bm_non(:) )
+                      biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - ( bm_non(:) - bm_to_litter(:,j,k,icarbon) )
+                   ENDWHERE
+                   bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) - MIN(bm_to_litter(:,j,k,icarbon), bm_non(:) )
+
+                ELSEWHERE
+
+                   bm_non(:) = MIN( bm_to_litter(:,j,k,icarbon), &
+                        total_bm_sapl_non(:,icarbon) *biomass_old(:,j,k,icarbon)/total_bm_c(:) )
+                   co2_to_bm(:,j) = co2_to_bm(:,j) + bm_new(:)/dt - bm_non(:)/dt
+                   bm_to_litter(:,j,k,icarbon)=bm_to_litter(:,j,k,icarbon)- bm_non(:)
+                ENDWHERE
+
+             ENDWHERE
+
+          ENDDO ! Loop over # litter tissues
+
+          IF (ANY( bm_to_litter(:,j,:,icarbon) .LT. 0.0 ) .OR. ANY( biomass(:,j,:,icarbon) .LT. 0.0 ) ) THEN
+             CALL ipslerr_p(3,'establish','something wrong in establish/gap.','','')
+          ENDIF 
+
+          !! 4.6 Decrease leaf age in youngest class if new leaf biomass is higher than old one.
+          WHERE ( d_ind(:,j) * bm_sapl(j,ileaf,icarbon) .GT. min_stomate )
+ 
+             ! reset leaf ages. Should do a real calculation like in the npp routine, 
+             ! but this case is rare and not worth messing around.
+             ! S. Zaehle 080806, added real calculation now, because otherwise leaf_age/leaf_frac
+             ! are not initialised for the calculation of vmax, and hence no growth at all.
+             ! logic follows that of stomate_npp.f90, just that it's been adjusted for the code here
+             leaf_age(:,j,1) = leaf_age(:,j,1) * leaf_mass_young(:) / &
+                  ( leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon) )
+
+          ENDWHERE
+
+          leaf_mass_young(:) = leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon)   
+
+          !! 4.7 Youngest class: new mass in youngest class divided by total new mass
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+             ! new age class fractions (fraction in youngest class increases)
+             leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+
+          !! 4.8 Other classes: old mass in leaf age class divided by new mass
+          DO m = 2, nleafages
+
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+                leaf_frac(:,j,m) = leaf_frac(:,j,m) * & 
+                     ( biomass(:,j,ileaf,icarbon) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon) ) /  biomass(:,j,ileaf,icarbon)
+
+             ENDWHERE
+
+          ENDDO
+
+          !! 4.9 Update age and number of individuals
+          WHERE ( d_ind(:,j) .GT. min_stomate )
+
+             age(:,j) = age(:,j) * ind(:,j) / ( ind(:,j) + d_ind(:,j) )
+
+             ind(:,j) = ind(:,j) + d_ind(:,j)
+
+          ENDWHERE
+
+          !! 4.10 Convert excess sapwood to heartwood
+          !!      No longer done : supressed by S. Zaehle given that the LPJ logic of carbon allocation was 
+          !!      contradictory to SLAVE allocation. See CVS tag 1_5 for initial formulation. 
+
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5. history
+
+    d_ind = d_ind / dt
+
+    CALL xios_orchidee_send_field("IND_ESTAB",d_ind)
+    CALL xios_orchidee_send_field("ESTABTREE",estab_rate_max_tree)
+    CALL xios_orchidee_send_field("ESTABGRASS",estab_rate_max_grass)
+
+    CALL histwrite_p (hist_id_stomate, 'IND_ESTAB', itime, d_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ESTABTREE', itime, estab_rate_max_tree, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'ESTABGRASS', itime, estab_rate_max_grass, npts, hori_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving establish'
+
+  END SUBROUTINE establish
+
+END MODULE lpj_establish
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_fire.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_fire.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_fire.f90	(revision 8430)
@@ -0,0 +1,581 @@
+! =================================================================================================================================
+! MODULE        : lpj_fire
+!
+! CONTACT	: orchidee-help _at_ listes.ipsl.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, litterpart, &
+       litterhum_daily, t2m_daily, lignin_struc,veget_cov_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,nvm,nlitt), INTENT(in)           :: litterpart          !! [DISPENSABLE] Fraction of litter above 
+                                                                                        !! the ground belonging to different PFTs 
+                                                                                        !! ?? this variable is used but might be 
+                                                                                        !! redundant (with value of always 1) ?? 
+                                                                                        !! To check but probably litterpart to be 
+                                                                                        !! removed. Probably a residual from 
+                                                                                        !! nat/agri before merge   
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: litterhum_daily     !! Daily litter moisture (unitless, 0-1)   
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: t2m_daily           !! Daily 2 meter temperature (K)   
+    REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(in)           :: lignin_struc        !! Ratio Lignin/Carbon in structural above 
+                                                                                        !! and below ground litter 
+                                                                                        !! @tex $(gC gC^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                 :: veget_cov_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)                                  :: residue            !! Fuel (either biomass or litter) not 
+                                                                                        !! burned  @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                  :: x                  !! Intermediate variable
+    REAL(r_std), DIMENSION(npts)                                  :: aff                !! Annual fire fraction (unitless, 0-1) 
+    INTEGER(i_std)                                                :: j,k,m              !! Indeces
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering fire'
+
+ !! 1. Initialization
+
+    IF ( firstcall_fire ) THEN
+
+       !! 1.1 Fraction to CO_2
+       !      What fraction of the plant biomass compartment, if burned, is transformed 
+       !      into CO_2 released to the atmosphere?
+       !??! the fraction for heartabove seems too big, it's not clear if this value is correct. 
+
+       !! 1.2 print control messages
+       IF (printlev >= 2) THEN
+          WRITE(numout,*) 'fire:'
+          WRITE(numout,*) '   > temporal inertia of fire probability (d): ',tau_fire
+          
+          WRITE(numout,*) '   > fraction of burned biomass that becomes CO2:'
+          WRITE(numout,*) '     leaves: ', co2frac(ileaf)
+          WRITE(numout,*) '     sap above ground: ', co2frac(isapabove)
+          WRITE(numout,*) '     sap below ground: ', co2frac(isapbelow)
+          WRITE(numout,*) '     heartwood above ground: ', co2frac(iheartabove)
+          WRITE(numout,*) '     heartwood below ground: ', co2frac(iheartbelow)
+          WRITE(numout,*) '     roots: ', co2frac(iroot)
+          WRITE(numout,*) '     fruits: ', co2frac(ifruit)
+          WRITE(numout,*) '     carbohydrate reserve: ', co2frac(icarbres)
+          
+          WRITE(numout,*) '   > critical litter quantity (gC/m**2): ',litter_crit
+          WRITE(numout,*) '   > We calculate a fire probability on agricultural ground, but'
+          WRITE(numout,*) '       the effective fire fraction is zero.'
+       END IF
+       firstcall_fire = .FALSE.
+
+    ENDIF
+
+    !! 1.4 Initialize output
+    co2_fire(:,:) = zero
+    firedeath(:,:) = zero
+    fireindex_daily(:,:) = zero
+    firefrac(:,:) = zero
+
+ !! 2. Determine fire probability
+ 
+    ! Calculate probability that crops are not burned for the moment
+    ! Calculate long-term aboveground litter
+ 
+    ! a long loop over PFT
+    DO j = 2,nvm !loop over #PFT
+
+       !! 2.1 Total above ground litter
+       !      Total litter above the ground for the PFT under consideration
+       litter_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(:) = &
+               ( litterpart(:,j,imetabolic)*litter(:,imetabolic,j,iabove,icarbon) + &
+               litterpart(:,j,istructural)*litter(:,istructural,j,iabove,icarbon)  ) / &
+               litter_above(:) * flam(j)
+
+       ENDWHERE
+
+       !! 2.3 Calculate daily fire index 
+       !      Calculate daily fire index
+       !      \latexonly
+       !        \input{lpj_fire_1.tex}  
+       !      \endlatexonly
+       !      Where, m is the daily litter moisture, m_e is the moisture of extinction, p(m) 
+       !      is probability of fire (i.e. the daily fire index).\n
+       WHERE ( moistlimit(:) .GT. min_stomate )
+          x(:) = litterhum_daily(:)/moistlimit(:)
+          fireindex_daily(:,j) = EXP( - pi * x(:) * x(:) )
+       ELSEWHERE
+          fireindex_daily(:,j) = zero
+       ENDWHERE
+
+       !! 2.4 Calculate long-term fire index 
+       !      Calculate long-term fire index which is the mean probability of fire
+       fireindex(:,j) = ((tau_fire - dt) * fireindex(:,j) + (dt) * fireindex_daily(:,j)) / tau_fire
+
+       !! 2.5 Calculate long term aboveground litter that are available for burning
+       firelitter(:,j) = &
+            ( ( tau_fire-dt ) * firelitter(:,j) + dt * litter_above(:) ) / tau_fire
+
+  !! 3. Calculate fire fraction from litter and fireindex
+
+       !! 3.1 Fire fraction from long term fire index for natural PFTs
+       !  Transform the annual fire fraction to daily fraction. This is done by assuming that
+       !  each day the fire fraction is the same. 
+       aff(:) = firefrac_func (npts, fireindex(:,j))
+
+       ! annual_fire_fraction = 1. - ( 1. - daily_fire_fraction )**365
+       ! Thus, daily_fire_fraction = 1. - ( 1. - annual_fire_fraction )**(1/365)
+       ! If annual firefrac<<1, then firefrac_daily = firefrac * dt/one_year
+       ! This approximation avoids numerical problems.
+       ! the variable 'un' is 1
+       IF(.NOT.disable_fire.AND.natural(j))THEN
+          WHERE ( aff(:) .GT. 0.1 )
+             firefrac(:,j) = un - ( un - aff(:) ) ** (dt/one_year)
+          ELSEWHERE
+             firefrac(:,j) = aff(:) * dt/one_year
+          ENDWHERE
+       ELSE
+          firefrac(:,j) = zero
+       ENDIF
+
+       ! No fire if litter is below critical value
+       WHERE ( firelitter(:,j) .LT. litter_crit )
+          firefrac(:,j) = zero
+       ENDWHERE
+
+       ! However, there is a minimum fire extent
+       firefrac(:,j) = MAX( 0.001_r_std * dt/one_year, firefrac(:,j) )
+
+       ! if FIRE_DISABLE flag is set no fire
+       IF (disable_fire) firefrac = zero
+       
+       !! 3.2 For agricultural ground, no fire is burned for the moment
+       IF ( .NOT. natural(j)) firefrac(:,j) = zero
+       
+  !! 4. Determine fire impact
+
+       ! Calculate fire disturbance fraction for each PFT, and fire emissions due 
+       ! to grasses.
+   
+       !! 4.1 Tree and grass live biomass 
+       ! Tree live biomass is not burned in fire. 
+       ! However, in the dynamic vegetation module, tree individual density 
+       ! will be updated after fire. The fraction of tree individuals that are 
+       ! supposed to die in fire is the fire fraction multiplied by the tree PFT fire 
+       ! resistance which reflect survivorship of different tree PFTs during fire.  
+       IF ( is_tree(j) ) THEN
+
+          !! 4.1.1 Disturban,ce factor for trees 
+          !        Trees are disturbed over the whole year. A resistance factor is  
+          !        used to reflect survivorship of different tree PFTs during fire. 
+          fire_disturb(:) = ( un - resist(j) ) * firefrac(:,j)
+
+       ELSE
+
+          !! 4.1.2 Disturbance factor for grasses 
+          !        Grass is not disturbed outside the growing season thus grass biomass 
+          !        is only burned during the growing season.
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             fire_disturb(:) = ( un - resist(j) ) * firefrac(:,j)
+
+          ELSEWHERE
+
+             fire_disturb(:) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+       !! 4.2 Burn live biomass
+       !      The burned part goes to either the atmposhere or litter
+       DO k = 1, nparts
+
+          ! for tree PFT, all biomass compartments are burned.
+          ! for grass biomass compartments, all are burned except root and carbon reserve
+          ! IF concerning PFT is tree; OR (the PFT is grass, but not root or carbon reserve biomass); then it's burned.
+          IF ( .NOT. ( ( .NOT. is_tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres ) ) ) ) THEN
+
+             !! 4.2.1 Fraction to the atmosphere.
+             co2_fire(:,j) =  co2_fire(:,j)+ biomass(:,j,k,icarbon) * fire_disturb(:) * co2frac(k) / dt
+
+             !! 4.2.2 Determine the residue
+             !        Residual is expressed in gC/m^2
+             residue(:) = biomass(:,j,k,icarbon) * fire_disturb(:) * ( un - co2frac(k) )
+
+             !! 4.2.2.3 The rest (largest part) of the residue becomes litter.
+             bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) + residue(:)
+          ENDIF
+
+       ENDDO
+
+      
+       !! 4.3 Update biomass pool after burning
+       
+       !! 4.3.1 Decrease biomass amount except for grass roots and carbon reserve.
+       DO m = 1, nelements ! Loop over # elements
+          
+          DO k = 1, nparts
+
+             ! **2
+             IF ( .NOT. ( ( .NOT. is_tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres) ) ) ) THEN
+                
+                biomass(:,j,k,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
+
+       !! 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_struct * 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
+
+       !! 5.2.3 Determine residue 
+       !        The residue is litter that undergoes fire, but is not transformed into CO2
+       residue(:) = litter(:,istructural,j,iabove,icarbon) * firefrac(:,j) * &
+            struc_residual(:)
+
+       !! 5.2.6 TResidue remaining litter
+       !        The rest (largest part) of the residue remains litter. Remaining 
+       !        litter is the sum of this and of the litter which has not undergone a fire.
+       litter(:,istructural,j,iabove,icarbon) = &
+            litter(:,istructural,j,iabove,icarbon) * ( un - firefrac(:,j) ) + &
+            residue(:)
+
+       !! 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)
+          
+          !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 histwrite_p (hist_id_stomate, 'FIREFRAC', itime, &
+         firefrac(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FIREDEATH', itime, &
+         firedeath(:,:), npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving fire'
+
+  END SUBROUTINE fire
+
+
+!! ================================================================================================================================
+!! FUNCTION     : firefrac_func
+!!
+!>\BRIEF        Calculate the annual fire fraction using long term fire index
+!! 
+!! DESCRIPTION	: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : annual fire fraction (::firefrac_result)
+!!
+!! REFERENCES   :
+!! - Thonicke K., Venevsky S., Sitch S., and Cramer W. (2001) The role of fire 
+!! disturbance for global vegetation dynamics: coupling fire into a Dynamic 
+!! Global Vegetation Model, Global Ecology & Biogeography, 10, 661-677.\n
+!!
+!! FLOWCHART    : None
+!! \n 
+!_ ================================================================================================================================
+   
+  FUNCTION firefrac_func (npts, x) RESULT (firefrac_result)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                 :: npts             !! Domain size (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)   :: x                !! fire index (unitless, 0-1)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts)               :: firefrac_result  !! fire fraction (unitless, 0-1)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)               :: xm1              !! intermediate variable
+!_ ================================================================================================================================
+
+!! 1. Function
+
+    xm1(:) = x(:) - 1.
+
+    ! this equation is from Thonicke et al. (2001) equation (9), it use the fire index as input to calculate annual fire fraction.
+    ! but with different parameters with the source literature.
+    !! \latexonly
+    !! \input{lpj_fire_2.tex}  
+    !! \endlatexonly
+    !! Where, s is the long term fire index and A(s) is the annual fire fraction.\n
+    !??! here we use a different parameter with K. Thonicke et al. (2001)
+    !??! it's not clear if these parameters are correct.
+    firefrac_result(:) = &
+         &     x(:) * EXP( xm1(:) / ( -firefrac_coeff(4)*xm1(:)*xm1(:)*xm1(:) + &
+         &     firefrac_coeff(3)*xm1(:)*xm1(:) + &
+         &     firefrac_coeff(2)*xm1(:) +  &      
+         &     firefrac_coeff(1) ) )
+
+  END FUNCTION firefrac_func
+
+END MODULE lpj_fire
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_gap.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_gap.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_gap.f90	(revision 8430)
@@ -0,0 +1,343 @@
+! =================================================================================================================================
+! MODULE       : lpj_gap
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Simulate mortality of individuals and update biomass, litter and 
+!! stand density of the PFT
+!!
+!!\n DESCRIPTION : Simulate mortality of individuals and update biomass, litter and 
+!! stand density of the PFT. This module differs from lpj_kill.f90 in that this 
+!! module kills individuals within a PFT and lpj_kill.f90 removes a PFT from a 
+!! gridbox
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!         plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!         global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation 
+!!         to canopy leaf area." Advances in Ecological Research 13: 327-354.\n
+!! 
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_gap
+
+  ! modules used:
+  USE xios_orchidee
+  USE stomate_data
+  USE pft_parameters
+  USE ioipsl_para 
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC gap,gap_clear
+  
+  ! Variable declaration 
+
+  LOGICAL, SAVE             :: firstcall_gap = .TRUE.                  !! first call flag
+!$OMP THREADPRIVATE(firstcall_gap)
+  REAL(r_std), PARAMETER    :: frost_damage_limit = -3 + ZeroCelsius   !! Spring frost-damage limitation (K)
+  REAL(r_std), PARAMETER    :: coldness_mort = 0.04                    !! Daily mortality induced by extreme coldness in winter
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gap_clear
+!!
+!>\BRIEF        Set the firstcall_gap flag back to .TRUE. to prepare for the next simulation.
+!_ ================================================================================================================================
+  
+  SUBROUTINE gap_clear
+    firstcall_gap = .TRUE.
+  END SUBROUTINE gap_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gap
+!!
+!>\BRIEF        Simulate tree and grass mortality, transfer dead biomass to litter and update stand density
+!!
+!! DESCRIPTION  : Calculate mortality of trees and grasses, transfer the dead biomass to litter pool,
+!! and update biomass pool and number of individuals. To get tree mortality, it's possible to choose either a 
+!! constant mortality rate; or to calculate the tree mortality rate based on it's growth efficiency, which is 
+!! defined as this year's net biomass increment per leaf area.\n
+!!
+!! When using growth efficiency mortality, first calculate the net biomass increment for the last year, then 
+!! calculate the growth efficiency and finally calculate the growth efficiency mortality.\n
+!!
+!! Eqation to calculate growth efficiency:
+!! \latexonly 
+!!     \input{gap1.tex}
+!! \endlatexonly
+!! Where $greff$ is growth efficiency, $\Delta$ is net biomass increment, 
+!! $C_{leaf} is last year's leaf biomass, and $SLA$ the specific leaf area. 
+!! 
+!!
+!! Eqation to calculate growth efficiency mortality:
+!! \latexonly 
+!!     \input{gap2.tex}
+!! \endlatexonly
+!! Where $mort_{greff}$ is the growth efficiency mortality, $greff$ is growth  
+!! efficiency, $k_{mort1}$ is asymptotic maximum mortality rate.
+!! 
+!! The name for variable ::availability is not well chosen. Actually the meaning of the variable is mortailty 
+!! rate derived from growth efficiency related mortality. ?? Suggestion: change the name "availability" to 
+!! "mortgref", which means "mortality caused by ".\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::biomass; biomass, ::ind density of individuals, ::bm_to_litter biomass transfer 
+!! to litter and ::mortality mortality (fraction of trees that is dying per time step)
+!!
+!! REFERENCE(S)   :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!         plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!         global vegetation model, Global Change Biology, 9, 161-185.
+!! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation 
+!!         to canopy leaf area." Advances in Ecological Research 13: 327-354.
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+  
+  SUBROUTINE gap (npts, dt, &
+       npp_longterm, turnover_longterm, lm_lastyearmax, &
+       PFTpresent, t2m_min_daily, Tmin_spring_time, &
+       biomass, ind, bm_to_litter, mortality )
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                              :: npts                    !! Domain size (-)
+    REAL(r_std), INTENT(in)                                 :: dt                      !! Time step (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: npp_longterm            !! "Long term" (default 3-year) net primary
+                                                                                       !! productivity  
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_longterm       !! "Long term" (default 3-year) turnover  
+                                                                                       !! rate @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: lm_lastyearmax          !! Last year's maximum leaf mass, for each 
+                                                                                       !! PFT @tex $(gC m^{-2})$ @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                :: PFTpresent              !! Is the pft present in the pixel
+    REAL(r_std), DIMENSION(npts), INTENT(in)                :: t2m_min_daily           !! Daily minimum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: Tmin_spring_time        !! Number of days after begin_leaves (leaf onset) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(out)            :: mortality               !! Mortality (fraction of trees that is 
+                                                                                       !! dying per time step)
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: biomass       !! Biomass @tex $(gC m^{-2}) $@endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                   :: ind           !! Number of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: bm_to_litter  !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                            :: delta_biomass           !! Net biomass increase for the previous 
+                                                                                       !! year @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts)                            :: dmortality              !! Dead biomass caused by mortality 
+                                                                                       !! @tex $(gC m^{-2}) $@endtex
+    REAL(r_std), DIMENSION(npts)                            :: vigour                  !! Growth efficiency, an indicator of tree 
+                                                                                       !! vitality, used to calculate mortality
+    REAL(r_std), DIMENSION(npts)                            :: availability            !! Mortality rate derived by growth 
+                                                                                       !! efficiency @tex $(year^{-1})$ @endtex 
+    INTEGER(i_std)                                          :: i, j,k,m                !! Indices
+
+!_ ================================================================================================================================
+
+    IF ( firstcall_gap ) THEN
+
+       firstcall_gap = .FALSE.
+
+    ENDIF
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering gap',lpj_gap_const_mort
+
+    mortality(:,:) = zero
+
+    ! loop over #PFT
+    DO j = 2,nvm
+
+ !! 1. Tree mortality
+
+       IF ( is_tree(j) ) THEN 
+
+          !! 1.1 Use growth efficiency or constant mortality?
+          IF ( .NOT.  lpj_gap_const_mort  ) THEN
+
+             !! 1.1.1 Estimate net biomass increment
+             !        To calculate growth efficiency mortality, first estimate net biomass increment by 
+             !        subtracting turnover from last year's NPP.
+             WHERE ( PFTpresent(:,j) .AND. ( lm_lastyearmax(:,j) .GT. min_stomate ) )
+
+            !??! the following should be removed
+            ! note that npp_longterm is now actually longterm growth efficiency (NPP/LAI)
+            ! to be fair to deciduous trees
+            ! calculate net biomass increment
+             delta_biomass(:) = MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf,icarbon) + &
+                  turnover_longterm(:,j,iroot,icarbon) + turnover_longterm(:,j,ifruit,icarbon) + & 
+                  turnover_longterm(:,j,isapabove,icarbon) + turnover_longterm(:,j,isapbelow,icarbon) ) ,zero)
+
+            !! 1.1.2 Calculate growth efficiency 
+            !        Calculate growth efficiency by dividing net biomass increment by last year's 
+            !        maximum LAI. (corresponding actually to the maximum LAI of the previous year)
+             vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j))
+
+             ELSEWHERE
+
+                vigour(:) = zero
+
+             ENDWHERE
+
+             !! 1.1.3 Calculate growth efficiency mortality rate
+             WHERE ( PFTpresent(:,j) )
+                
+                availability(:) = availability_fact(j) / ( un + ref_greff * vigour(:) )
+                ! Scale mortality by timesteps per year
+                mortality(:,j) = MAX(min_avail,availability(:))  * dt/one_year  
+
+             ENDWHERE
+
+          ELSE  ! .NOT. lpj_gap_const_mort
+
+             !! 1.2 Use constant mortality accounting for the residence time of each tree PFT
+             WHERE ( PFTpresent(:,j) )
+
+                mortality(:,j) = dt/(residence_time(j)*one_year)
+
+             ENDWHERE
+
+          ENDIF ! .NOT.  lpj_gap_const_mort
+
+          !! 1.3 Mortality in DGVM
+          !      If the long term NPP is zero, all trees are killed
+          !??! This is this only applied in the DGVM maybe in order to make the DGVM respond faster and thus make the vegetation dynamics more dynamic?
+          !??! the link here with lpj_kill.f90 is still not clear and so would leave to who especially working on this. 
+          IF ( ok_dgvm ) THEN
+
+             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. min_stomate ) )
+
+                mortality(:,j) = un
+
+             ENDWHERE
+
+          ENDIF
+
+          IF ( ok_dgvm .AND. (tmin_crit(j) .NE. undef) ) THEN
+             ! frost-sensitive PFTs
+             WHERE ( t2m_min_daily(:) .LT. tmin_crit(j) )
+                mortality(:,j) = MIN(un,(coldness_mort*(tmin_crit(j)-t2m_min_daily(:))+mortality(:,j) ) )
+             ENDWHERE
+          ENDIF
+
+          IF ( ok_dgvm .AND. leaf_tab(j)==1 .AND. pheno_type(j)==2) THEN
+             ! Treat the spring frost for broadleaf and summergreen vegetations
+             ! leaf_tab=broadleaf and pheno_typ=summergreen
+             DO i=1,npts
+                IF ( (Tmin_spring_time(i,j)>0) .AND. (Tmin_spring_time(i,j)<spring_days_max+1) ) THEN
+                   IF ( t2m_min_daily(i) .LT. frost_damage_limit ) THEN
+                      mortality(i,j) = MIN(un,(0.01*(frost_damage_limit-t2m_min_daily(i))* &
+                           Tmin_spring_time(i,j)/spring_days_max+mortality(i,j) ) )
+                   END IF
+                END IF
+             END DO
+          END IF
+       
+
+          !! 1.4 Update biomass and litter pools 
+          !    Update biomass and litter pool after dying and transfer recently died biomass to litter
+          
+          DO m = 1,nelements
+             DO k = 1, nparts
+                
+                WHERE ( PFTpresent(:,j) )
+                   
+                   dmortality(:) =  mortality(:,j) * biomass(:,j,k,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-AFP/src_stomate/lpj_kill.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_kill.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_kill.f90	(revision 8430)
@@ -0,0 +1,264 @@
+! =================================================================================================================================
+! MODULE       : lpj_kill
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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_cov_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_cov_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_cov_max   !! "Maximal" coverage fraction of a PFT (LAI -> 
+                                                                                 !! infinity) on ground (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "Long term" (default = 3-year) net primary 
+                                                                                 !! productivity 
+                                                                                 !! @tex $(gC.m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class 
+                                                                                 !! (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass       !! Biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter  !! Conversion of biomass to litter 
+                                                                                      !! @tex $(gC.m^{-2} day^{-1})$ @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: j,m             !! Indices       (unitless)
+    LOGICAL, DIMENSION(npts)                                  :: was_killed      !! Bookkeeping   (true/false)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering kill'
+
+ !! 1. Kill PFTs
+
+    ! Kill plants if number of individuals or last year's leaf mass is close to zero.
+    ! the "was_killed" business is necessary for a more efficient code on the VPP processor
+    DO j = 2,nvm ! loop plant functional types
+
+       was_killed(:) = .FALSE.
+
+       IF ( natural(j) ) THEN
+
+          !! 1.1 Kill natural PFTs when DGVM is activated
+          IF ( ok_dgvm ) THEN
+             WHERE ( PFTpresent(:,j) .AND. &
+                  ( ( ind(:,j) .LT. min_stomate ) .OR. &
+                  ( lm_lastyearmax(:,j) .LT. min_stomate ) ) )
+             
+                was_killed(:) = .TRUE.
+             
+             ENDWHERE
+          
+          ELSE
+
+             !! 1.2 Kill natural PFTs when running STOMATE without DGVM
+
+             !! 1.2.1 Kill PFTs
+             WHERE ( PFTpresent(:,j) .AND. & 
+                  (biomass(:,j,icarbres,icarbon) .LE.zero .OR. & 
+                  biomass(:,j,iroot,icarbon).LT.-min_stomate .OR. biomass(:,j,ileaf,icarbon).LT.-min_stomate ).AND. & 
+                  ind(:,j).GT. zero)
+
+                was_killed(:) = .TRUE.
+
+             ENDWHERE
+
+             !! 1.2.2 Overwrite long-term NPP for grasses
+             IF(.NOT.is_tree(j).AND..NOT.lpj_gap_const_mort)THEN
+                WHERE ( was_killed(:) )
+
+                   npp_longterm(:,j) = 500.
+
+                ENDWHERE
+             ENDIF
+
+          ENDIF ! ok_dgvm
+
+          !! 1.3 Bookkeeping for PFTs that were killed
+          !      For PFTs that were killed, return biomass pools to litter 
+          !      and update biomass pools to zero
+          IF ( ANY( was_killed(:) ) ) THEN
+          
+             DO m = 1,nelements
+
+                WHERE ( was_killed(:) )
+
+                   bm_to_litter(:,j,ileaf,m) = bm_to_litter(:,j,ileaf,m) + biomass(:,j,ileaf,m)
+                   bm_to_litter(:,j,isapabove,m) = bm_to_litter(:,j,isapabove,m) + biomass(:,j,isapabove,m)
+                   bm_to_litter(:,j,isapbelow,m) = bm_to_litter(:,j,isapbelow,m) + biomass(:,j,isapbelow,m)
+                   bm_to_litter(:,j,iheartabove,m) = bm_to_litter(:,j,iheartabove,m) + &
+                                                     biomass(:,j,iheartabove,m)
+                   bm_to_litter(:,j,iheartbelow,m) = bm_to_litter(:,j,iheartbelow,m) + &
+                                                     biomass(:,j,iheartbelow,m)
+                   bm_to_litter(:,j,iroot,m) = bm_to_litter(:,j,iroot,m) + biomass(:,j,iroot,m)
+                   bm_to_litter(:,j,ifruit,m) = bm_to_litter(:,j,ifruit,m) + biomass(:,j,ifruit,m)
+                   bm_to_litter(:,j,icarbres,m) = bm_to_litter(:,j,icarbres,m) + biomass(:,j,icarbres,m)
+                   
+                   biomass(:,j,ileaf,m) = zero
+                   biomass(:,j,isapabove,m) = zero
+                   biomass(:,j,isapbelow,m) = zero
+                   biomass(:,j,iheartabove,m) = zero
+                   biomass(:,j,iheartbelow,m) = zero
+                   biomass(:,j,iroot,m) = zero
+                   biomass(:,j,ifruit,m) = zero
+                   biomass(:,j,icarbres,m) = zero
+
+                ENDWHERE   ! was_killed
+
+             END DO
+
+            !! 1.4 Update veget_cov_max in DGVM
+            !      Update veget_cov_max in DGVM for killed PFTs and reset RIP_time
+            IF (ok_dgvm) THEN
+
+                WHERE ( was_killed(:) )
+                   PFTpresent(:,j) = .FALSE.
+
+                   veget_cov_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-AFP/src_stomate/lpj_light.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_light.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_light.f90	(revision 8430)
@@ -0,0 +1,635 @@
+! =================================================================================================================================
+! MODULE       : lpj_light
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Light competition within a PFT
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_light
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE constantes
+  USE stomate_data
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC light, light_clear
+
+  LOGICAL, SAVE                                            :: firstcall_light = .TRUE.             !! first call
+!$OMP THREADPRIVATE(firstcall_light)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : light_clear
+!!
+!>\BRIEF          Activation
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE light_clear
+    firstcall_light=.TRUE.
+  END SUBROUTINE light_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: light
+!!
+!>\BRIEF         Light competition within a PFT
+!!
+!! DESCRIPTION  : This module kills PFTs based on light competition
+!! 
+!! Here, fpc ("foilage projected cover") takes into account the minimum fraction
+!! of space covered by trees through branches etc. This is done to prevent strong relative
+!! changes of FPC from one day to another for deciduous trees at the beginning of their
+!! growing season, which would yield too strong cutbacks.\n
+!!
+!! fpc is now always calculated from lm_lastyearmax*sla, since the aim of this DGVM is 
+!! to represent community ecology effects; seasonal variations in establishment related to phenology
+!! may be relevant, but beyond the scope of a 1st generation DGVM.\n
+!!
+!! If agriculture is present, fpc can never reach 1.0 since natural veget_cov_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_cov_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, &
+       lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality)
+
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: npts                     !! Domain size (unitless)      
+    REAL(r_std), INTENT(in)                                :: dt                       !! Time step (days)      
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent               !! TRUE if pft is present (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: cn_ind                   !! Crown area of individuals 
+                                                                                       !! @tex $(m^2)$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: lai                      !! Leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: maxfpc_lastyear          !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT(unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: lm_lastyearmax           !! Last year's maximum leafmass for each 
+                                                                                       !! natural PFT 
+                                                                                       !! @tex $(gC m^2 s^{-1})$ @endtex   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_cov_max            !! Current year's maximum fpc for each natural 
+                                                                                       !! PFT (unitless;0-1)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: fpc_max                  !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT (unitless)    
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ind                      !! Number of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gCm^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: veget_lastlight          !! Vegetation cover after last light 
+                                                                                       !! competition (unitless;0-1)     
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter   !! Biomass transfer to litter per timestep
+                                                                                       !! @tex $(gCm^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: mortality                !! Fraction of individuals that died this 
+                                                                                       !! time step per dt (unitless;0-1)   
+
+    !! 0.4 Local variables
+
+    LOGICAL, PARAMETER                                     :: annual_increase = .TRUE. !! For diagnosis of fpc increase, compare 
+                                                                                       !! today's fpc to last year's  Maximum (T)
+                                                                                       !! or to fpc of last time step (F) 
+    INTEGER(i_std)                                         :: i,j,k,m                  !! Index (unitless)    
+    REAL(r_std), DIMENSION(npts)                           :: sumfpc                   !! Total natural fpc, sum of all the PFTs
+                                                                                       !! (unitless)   
+    REAL(r_std), DIMENSION(npts)                           :: fracnat                  !! Fraction of natural vegetation within a 
+                                                                                       !! grid cell (unitless;0-1)   
+    REAL(r_std)                                            :: sumfpc_wood              !! Total natural woody fpc (unitless)   
+    REAL(r_std)                                            :: sumdelta_fpc_wood        !! Change in total woody fpc (unitless)   
+    REAL(r_std)                                            :: maxfpc_wood              !! Maximum wood fpc (unitless)   
+    INTEGER(i_std)                                         :: optpft_wood              !! Which woody pft is maximum (unitless)   
+    REAL(r_std)                                            :: sumfpc_grass             !! Total natural grass fpc (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm)                       :: fpc_nat                  !! This year's foliage projected cover on 
+                                                                                       !! natural part of the grid cell 
+                                                                                       !! @tex $(m^2)$ @endtex
+    REAL(r_std), DIMENSION(nvm)                            :: deltafpc                 !! fpc change within last year (unitless)    
+    REAL(r_std)                                            :: reduct                   !! Relative change of number of individuals
+                                                                                       !! for trees (ind)    
+    REAL(r_std), DIMENSION(nvm)                            :: survive                  !! Fraction of plants that survive 
+                                                                                       !! (unitless;0-1)     
+    REAL(r_std), DIMENSION(npts)                           :: fpc_real                 !! FPC for static mode (unitless)     
+    REAL(r_std), DIMENSION(npts)                           :: lai_ind                  !! FPC mortality for static mode     
+    REAL(r_std)                                            :: sumfpc_grass2            !! New total grass fpc     
+    REAL(r_std), DIMENSION(npts,nvm)                       :: light_death              !! Fraction of plants that dies each day 
+                                                                                       !! @tex $(day^{-1})$ @endtex     
+    REAL(r_std)                                            :: fpc_dec                  !! Relative change of number of individuals 
+                                                                                       !! for trees
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering light'
+
+    
+ !! 1. Write diagnostics to out_orchidee files
+  
+    IF ( firstcall_light ) THEN
+
+       WRITE(numout,*) 'light:'
+
+       WRITE(numout,*) '   > For trees, minimum fraction of crown area covered'
+       WRITE(numout,*) '       (due to its branches etc.)', min_cover
+
+       WRITE(numout,*) '   > for diagnosis of fpc increase, compare today''s fpc'
+       IF ( annual_increase ) THEN
+          WRITE(numout,*) '     to last year''s maximum.'
+       ELSE
+          WRITE(numout,*) '     to fpc of the last time step.'
+       ENDIF
+
+       firstcall_light = .FALSE.
+
+    ENDIF
+
+!! 2. Light competition in DGVM
+
+    IF (ok_dgvm) THEN
+             
+       !! 2.1 Calculate natural part of the grid cell
+       fracnat(:) = un
+       DO j = 2,nvm
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_cov_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_cov_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_cov_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( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ), min_cover )
+                   ENDIF
+                ENDDO
+
+             ELSE
+
+                !! 2.5.1.2 Grasses
+                DO i = 1, npts
+
+                   !NVMODIF         
+                   !            IF (lai(i,j) == val_exp) THEN
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   !             ELSE
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
+                   !                     ( un - exp( -lai(i,j) * ext_coeff(j) ) )
+                   !             ENDIF
+                   !!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+
+                   IF (lai(i,j) == val_exp) THEN
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   ELSE
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
+                           ( un - exp( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) )
+                   ENDIF
+                ENDDO
+             ENDIF    ! tree/grass
+
+          ELSE
+
+             !! 2.5.2 Agricultural PFTs
+             !        Agricultural PFTs are not present on the natural part of the grid point
+             veget_lastlight(:,j) = zero
+
+          ENDIF  ! natural/agricultural
+
+       ENDDO ! # PFTs
+
+    ELSE ! ok_dgvm
+
+ !! 3. Light competition in stomate (without DGVM)
+
+       light_death(:,:) = zero
+
+       DO j = 2, nvm 
+
+          IF ( natural(j) ) THEN
+
+	     !! NUMBERING BELOW SHOULD BE 5.0 or 4.3
+             !! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses,
+             !! neither a redistribution of mortality (delta fpc)
+             
+             !! 3.1 XXX
+             WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate ) 
+                lai_ind(:) = sla(j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) )
+             ELSEWHERE
+                lai_ind(:) = zero
+             ENDWHERE
+
+             fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+             WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
+
+                light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j)) 
+
+             ENDWHERE
+
+             !! 3.2 Update biomass and litter pools
+             DO m = 1,nelements
+                DO k=1,nparts
+                   
+                   bm_to_litter(:,j,k,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-AFP/src_stomate/lpj_pftinout.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_pftinout.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/lpj_pftinout.f90	(revision 8430)
@@ -0,0 +1,487 @@
+! =================================================================================================================================
+! MODULE       : lpj_pftinout
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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
+
+  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_cov_max, &
+       biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
+       PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
+       co2_to_bm, &
+       avail_tree, avail_grass)
+    
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size - number of pixels (unitless)            
+    REAL(r_std), INTENT(in)                                   :: dt              !! Time step of vegetation dynamics for stomate
+                                                                                 !! (days)               
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: adapted         !! Winter not too cold (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: regenerate      !! Winter sufficiently cold (unitless)  
+    INTEGER(i_std), DIMENSION(npts,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_cov_max   !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                                 !! infinity) on ground (unitless)        
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: avail_tree      !! Space availability for trees (unitless)   
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: avail_grass     !! Space availability for grasses (unitless)      
+
+
+    !! 0.3 Modified variables   
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass  !! Biomass (gC m^{-2})      
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Density of individuals (m^{-2})
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: cn_ind          !! Crown area of individuals (m^2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! Mean age (years)            
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "long term" net primary productivity 
+                                                                                 !! (gC m^{-2} year^{-1})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: lm_lastyearmax  !! Last year's maximum leaf mass, for each PFT 
+                                                                                 !! (gC m^{-2})  
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence      !! Plant senescent for deciduous trees; .FALSE. 
+                                                                                 !! if PFT is introduced or killed      
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! PFT exists    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very 
+                                                                                 !! localized (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! how many days ago was the beginning of the 
+                                                                                 !! growing season (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: need_adjacent   !! in order for this PFT to be introduced, does it
+                                                                                 !! have to be present in an adjacent grid box?   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time        !! How much time ago was the PFT eliminated for 
+                                                                                 !! the last time (years)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! biomass uptaken (gC m^{-2} day^{-1})        
+ 
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                              :: avail           !! availability           
+    INTEGER(i_std)                                            :: i,j,m           !! indices      
+    REAL(r_std), DIMENSION(npts)                              :: sumfrac_wood    !! total woody vegetation cover     
+    INTEGER(i_std), DIMENSION(npts)                           :: n_present       !! number of adjacent grid cells where PFT is 
+                                                                                 !! ubiquitous        
+    LOGICAL, DIMENSION(npts)                                  :: can_introduce   !! we can introduce this PFT    
+    REAL(r_std), DIMENSION(npts)                              :: fracnat         !! no real need for dimension(ntps) except for 
+                                                                                 !! vectorisation          
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering pftinout'
+
+  !! 1. Messages    
+
+    IF ( firstcall_pftinout ) THEN
+
+       WRITE(numout,*) 'pftinout: Minimum space availability: ', min_avail
+
+       firstcall_pftinout = .FALSE.
+
+    ENDIF
+
+  !! 2. Total woody fpc and space avaibility on grid
+
+    ! Only natural part of the grid cell\n
+    ! S. Zaehle bug correction MERGE: need to subtract agricultural area!
+    ! fraction of agricultural surface
+
+    !! 2.1 only natural PFT
+    fracnat(:) = un
+    DO j = 2,nvm ! Loop over # PFTs
+       IF ( .NOT. natural(j) ) THEN
+          fracnat(:) = fracnat(:) - veget_cov_max(:,j)
+       ENDIF
+    ENDDO ! Loop over # PFTs
+
+    !! 2.2 Total woody fractional plant cover
+    sumfrac_wood(:) = zero
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       ! S. Zaehle problem here: agriculture, not convinced that this representation of LPJ is correct
+       ! if agriculture is present, ind must be recalculated to correspond to the natural density...
+       ! since ind is per grid cell, can be achived by discounting for agricultura fraction
+       IF ( natural(j).AND.is_tree(j) ) THEN
+          WHERE(fracnat(:).GT.min_stomate) 
+                sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                     * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                !lai changed to lm_last
+          ENDWHERE
+       ENDIF
+    ENDDO ! Loop over # PFTs
+
+    !! 2.3 Space availability
+    avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail )
+    avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail )
+
+  !! 3. Time since last elimination (y)
+
+    RIP_time = RIP_time + dt / one_year
+
+  !! 4. Agicultural PFTs
+
+    ! Agricultural PFTs are only present if they are prescribed
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       IF ( .NOT. natural(j) ) THEN
+          
+          IF (printlev>=4) WRITE(numout,*) 'pftinout: Agricultural PFTs'
+          
+          !! 4.1 Agricultural trees
+          !      Agricultural trees are not treated for the moment
+          IF ( is_tree(j) ) THEN
+
+             CALL ipslerr_p(3,'pftinout','Agricultural trees not treated.','','')
+
+          !! 4.2 Initialization of agricultural grass lands
+          !      Initialize parameter values of prescribed agricultural PFTs
+          ELSE
+
+             DO i = 1, npts ! Loop over # pixels - domain size
+
+                IF ( ( veget_cov_max(i,j) .GT. min_stomate ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN
+
+                   ! prescribed, but not yet there.
+                   ind(i,j) = veget_cov_max(i,j)
+                   biomass(i,j,:,:) = bm_sapl(j,:,:) * ind(i,j) /veget_cov_max(i,j) 
+                   co2_to_bm(i,j) =  co2_to_bm(i,j) +SUM( biomass(i,j,:,icarbon) ) / dt
+                   PFTpresent(i,j) = .TRUE.
+                   everywhere(i,j) = un
+                   senescence(i,j) = .FALSE.
+                   age(i,j) = zero
+
+                ENDIF  ! prescribed, but PFT not yet present
+
+             ENDDO ! Loop over # pixels - domain size
+
+          ENDIF
+
+       ENDIF ! not natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5 Eliminate PFTs
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       ! only for natural PFTs
+       IF ( natural(j) ) THEN
+
+          ! Number of individuals are set to zero in the condition of cold winter   
+          ! 'adapted_crit' critical value for being adapted = 1.-(1./euler); see 'stomate_constants.f90'
+          WHERE (  PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) )
+
+             ! PFT there, but not adapted any more (ex: winter too cold): kill
+             ! set number of individuals to zero - rest will be done in lpj_kill
+             ind(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 6. Introduce PFTs
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+
+          ! space availability for this PFT
+          IF ( is_tree(j) ) THEN
+             avail(:) = avail_tree(:)
+          ELSE
+             avail(:) = avail_grass(:)
+          ENDIF
+          
+          !! 6.1 Check if PFT not present but (adapted and regenerative)     
+          can_introduce(:) = .FALSE.
+          
+          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_cov_max(:,j) .GT. min_stomate)
+                biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j) /veget_cov_max(:,j)
+                biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j) /veget_cov_max(:,j)
+                biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)/veget_cov_max(:,j)
+                biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)/veget_cov_max(:,j)
+                biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)/veget_cov_max(:,j)
+                biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)/veget_cov_max(:,j)
+                biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)/veget_cov_max(:,j)
+                biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)/veget_cov_max(:,j)
+             ELSEWHERE              
+                biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
+                biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j)
+                biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)
+                biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)
+                biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)
+                biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)
+                biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)
+                biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)
+             END WHERE
+            
+             co2_to_bm(:,j) = &
+                  co2_to_bm(:,j) +  &
+                  ( biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
+                  biomass(:,j,isapbelow,icarbon) + biomass(:,j,iheartabove,icarbon) + &
+                  biomass(:,j,iheartbelow,icarbon) + biomass(:,j,iroot,icarbon) + &
+                  biomass(:,j,ifruit,icarbon) + biomass(:,j,icarbres,icarbon) )/dt
+
+             when_growthinit(:,j) = large_value
+
+             age(:,j) = zero
+
+             ! all leaves are young
+             leaf_frac(:,j,1) = un
+
+             ! non-zero "long term" npp and last year's leaf mass for saplings -
+             ! so they won't be killed off by gap or kill
+             npp_longterm(:,j) = npp_longterm_init
+
+             lm_lastyearmax(:,j) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
+
+          ENDWHERE    ! we can introduce the PFT
+
+          !! 6.4 Expansion of the PFT within the grid box 
+          !      PFT expansion/dispersion to a new grid box should not be confused with 
+          !      expansion in areal coverage
+          IF ( treat_expansion ) THEN
+
+             WHERE ( can_introduce(:) )
+
+                ! low value at the beginning
+                everywhere(:,j) = everywhere_init
+             ENDWHERE
+
+          ELSE
+
+             ! expansion is not treated
+             WHERE ( can_introduce(:) )
+                everywhere(:,j) = un
+             ENDWHERE
+
+          ENDIF ! treat expansion
+
+       ENDIF ! only natural PFTs
+
+    ENDDO ! Loop over # PFTs
+
+  !! 7. If a PFT has been present once in a grid box, we suppose that it will survive
+
+    !   If a PFT has been present once in a grid box, we suppose that it will survive
+    !   in isolated places (e.g., an oasis) within that grid box, even if it gets
+    !   officially eliminated from it later. That means that if climate becomes favorable
+    !   again, it will not need to get seeds from adjacent grid cells.
+    WHERE ( PFTpresent )
+       need_adjacent = .FALSE.
+    ENDWHERE
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving pftinout'
+
+  END SUBROUTINE pftinout
+
+END MODULE lpj_pftinout
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate.f90	(revision 8430)
@@ -0,0 +1,4818 @@
+! =================================================================================================================================
+! MODULE       : stomate
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_day, one_year, dt_sechiba, dt_stomate, LastTsYear, LastTsMonth
+  USE time, ONLY : year_end, month_end, day_end, sec_end
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE stomate_io
+  USE stomate_data
+  USE stomate_season
+  USE stomate_lpj
+  USE stomate_litter
+  USE stomate_vmax
+  USE stomate_soilcarbon
+  USE stomate_resp
+  USE mod_orchidee_para
+  USE ioipsl_para 
+  USE xios_orchidee
+
+  USE matrix_resolution
+  
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC stomate_main,stomate_clear,init_forcing, stomate_forcing_read, stomate_initialize, stomate_finalize!, setlai !liulyt add setlai for lpj use
+
+  INTERFACE stomate_accu
+     MODULE PROCEDURE stomate_accu_r1d, stomate_accu_r2d, stomate_accu_r3d
+  END INTERFACE
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: biomass              !! Biomass per ground area @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(biomass)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_cov_max        !! Maximal fractional coverage: maximum share of a pixel
+                                                                         !! taken by a PFT 
+!$OMP THREADPRIVATE(veget_cov_max)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ind                  !! Vegetation density, number of individuals per unit 
+                                                                         !! ground area @tex $(m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(ind)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: age                  !! Age of PFT it normalized by biomass - can increase and
+                                                                         !! decrease - (years)
+!$OMP THREADPRIVATE(age)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: adapted              !! Winter too cold for PFT to survive (0-1, unitless)
+!$OMP THREADPRIVATE(adapted)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: regenerate           !! Winter sufficiently cold to produce viable seeds 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(regenerate)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: everywhere           !! Is the PFT everywhere in the grid box or very localized 
+                                                                         !! (after its intoduction)
+!$OMP THREADPRIVATE(everywhere)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: fireindex            !! Probability of fire (unitless)
+!$OMP THREADPRIVATE(fireindex)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_lastlight      !! Vegetation fractions (on ground) after last light 
+                                                                         !! competition (unitless) 
+!$OMP THREADPRIVATE(veget_lastlight)
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)   :: fpc_max              !! "maximal" coverage fraction of a grid box (LAI -> 
+                                                                         !! infinity) on ground. [??CHECK??] It's set to zero here, 
+                                                                         !! and then is used once in lpj_light.f90 to test if 
+                                                                         !! fpc_nat is greater than it. Something seems missing
+!$OMP THREADPRIVATE(fpc_max)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: PFTpresent           !! PFT exists (equivalent to veget > 0 for natural PFTs)
+!$OMP THREADPRIVATE(PFTpresent)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: senescence           !! The PFT is senescent
+!$OMP THREADPRIVATE(senescence)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: begin_leaves         !! Signal to start putting leaves on (true/false)
+!$OMP THREADPRIVATE(begin_leaves)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: need_adjacent        !! This PFT needs to be in present in an adjacent gridbox 
+                                                                         !! if it is to be introduced in a new gridbox
+!$OMP THREADPRIVATE(need_adjacent)
+!--
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_daily         !! Daily plant available water -root profile weighted 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_week          !! "Weekly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_month         !! "Monthly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_lastyear   !! Last year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)
+!$OMP THREADPRIVATE(maxhumrel_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_thisyear   !! This year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless) 
+!$OMP THREADPRIVATE(maxhumrel_thisyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_lastyear   !! Last year's min plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)  
+!$OMP THREADPRIVATE(minhumrel_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_thisyear   !! This year's minimum plant available water -root profile
+                                                                         !! weighted (0-1, unitless)
+!$OMP THREADPRIVATE(minhumrel_thisyear)
+!---  
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_daily            !! Daily air temperature at 2 meter (K)
+!$OMP THREADPRIVATE(t2m_daily)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason              !! "seasonal" 2 meter temperatures (K)
+!$OMP THREADPRIVATE(Tseason)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason_length       !! temporary variable to calculate Tseason
+!$OMP THREADPRIVATE(Tseason_length)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason_tmp          !! temporary variable to calculate Tseason
+!$OMP THREADPRIVATE(Tseason_tmp)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: Tmin_spring_time     !! Number of days after begin_leaves (leaf onset) 
+!$OMP THREADPRIVATE(Tmin_spring_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: onset_date           !! Date in the year at when the leaves started to grow(begin_leaves), only for diagnostics.
+!$OMP THREADPRIVATE(onset_date)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_week             !! Mean "weekly" (default 7 days) air temperature at 2 
+                                                                         !! meter (K)  
+!$OMP THREADPRIVATE(t2m_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_month            !! Mean "monthly" (default 20 days) air temperature at 2 
+                                                                         !! meter (K)
+!$OMP THREADPRIVATE(t2m_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_longterm         !! Mean "Long term" (default 3 years) air temperature at 
+                                                                         !! 2 meter (K) 
+!$OMP THREADPRIVATE(t2m_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_min_daily        !! Daily minimum air temperature at 2 meter (K)
+!$OMP THREADPRIVATE(t2m_min_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: tsurf_daily          !! Daily surface temperatures (K)
+!$OMP THREADPRIVATE(tsurf_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_daily         !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex
+!$OMP THREADPRIVATE(precip_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_lastyear      !! Last year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex
+!$OMP THREADPRIVATE(precip_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_thisyear      !! This year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex 
+!$OMP THREADPRIVATE(precip_thisyear)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_daily        !! Daily soil humidity (0-1, unitless)
+!$OMP THREADPRIVATE(soilhum_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_month        !! Soil humidity - integrated over a month (0-1, unitless) 
+!$OMP THREADPRIVATE(soilhum_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_daily          !! Daily soil temperatures (K)
+!$OMP THREADPRIVATE(tsoil_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_month          !! Soil temperatures at each soil layer integrated over a
+                                                                         !! month (K) 
+!$OMP THREADPRIVATE(tsoil_month)
+!--- 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: litterhum_daily      !! Daily litter humidity (0-1, unitless)
+!$OMP THREADPRIVATE(litterhum_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_moist        !! Moisture control of heterotrophic respiration 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(control_moist)
+  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
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)    :: VPD_daily             !! xchen Daily VPD
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)    :: VPD_week              !! xchen weekly VPD
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)        :: swdown_daily           !! xchen daily swdown   
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)        :: swdown_week            !! xchen weekly swdown
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)        :: precip_week            !! xchen weekly swdown
+
+  !$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(:,:,:)  :: litterpart           !! Fraction of litter above the ground belonging to 
+                                                                         !! different litter pools (unitless)
+!$OMP THREADPRIVATE(litterpart)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: firelitter           !! Total litter above the ground that could potentially 
+                                                                         !! burn @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(firelitter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: soilcarbon_input     !! Quantity of carbon going into carbon pools from litter
+                                                                         !! decomposition per ground area  at Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(soilcarbon_input)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: soilcarbon_input_daily !! Daily quantity of carbon going into carbon pools from
+                                                                           !! litter decomposition per ground area 
+                                                                           !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+!$OMP THREADPRIVATE(soilcarbon_input_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: carbon               !! Soil carbon pools per ground area: active, slow, or 
+                                                                         !! passive, @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(carbon)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: 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(:,:)    :: lm_lastyearmax       !! Last year's maximum leaf mass per ground area for each
+                                                                         !! PFT @tex $(gC m^{-2})$ @endtex  
+!$OMP THREADPRIVATE(lm_lastyearmax)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lm_thisyearmax       !! This year's maximum leaf mass per ground area for each
+                                                                         !! PFT @tex $(gC m^{-2})$ @endtex  
+!$OMP THREADPRIVATE(lm_thisyearmax)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxfpc_lastyear      !! Last year's maximum fpc for each natural PFT, on ground
+                                                                         !! [??CHECK] fpc but this ones look ok (computed in 
+                                                                         !! season, used in light)?? 
+!$OMP THREADPRIVATE(maxfpc_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxfpc_thisyear      !! This year's maximum fpc for each PFT, on ground (see 
+                                                                         !! stomate_season), [??CHECK] fpc but this ones look ok 
+                                                                         !! (computed in season, used in light)??
+!$OMP THREADPRIVATE(maxfpc_thisyear)
+!---
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_age             !! Age of different leaf classes (days)
+!$OMP THREADPRIVATE(leaf_age)
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_frac            !! PFT fraction of leaf mass in leaf age class (0-1, 
+                                                                         !! unitless) 
+!$OMP THREADPRIVATE(leaf_frac)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: when_growthinit      !! Days since beginning of growing season (days)
+!$OMP THREADPRIVATE(when_growthinit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: herbivores           !! Time constant of probability of a leaf to be eaten by a
+                                                                         !! herbivore (days)
+!$OMP THREADPRIVATE(herbivores)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: RIP_time             !! How much time ago was the PFT eliminated for the last 
+                                                                         !! time (year)
+!$OMP THREADPRIVATE(RIP_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: time_hum_min         !! Time elapsed since strongest moisture limitation (days) 
+!$OMP THREADPRIVATE(time_hum_min)
+!---
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: clay_fm              !! Soil clay content (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: clay_fm_g            !! Soil clay content (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: 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
+!! liulyc liulyw link to xuhui's crop
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)       :: swdown_fm              !! downward shortwave radiation
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)       :: swdown_fm_g            !! downward shortwave radiation
+
+!---
+  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(:,:)    :: nep_daily            !! Daily net CO2 flux (positive from atmosphere to land)
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(nep_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: nep_monthly          !! Monthly net CO2 flux (positive from atmosphere to land) 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(nep_monthly)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: prod10               !! Wood products remaining in the 10 year-turnover pool 
+                                                                         !! after the annual release for each compartment 
+                                                                         !! @tex $(gC m^{-2})$ @endtex    
+                                                                         !! (0:10 input from year of land cover change),
+                                                                         !! dimension(#pixels,0:10 years
+!$OMP THREADPRIVATE(prod10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: prod100              !! Wood products remaining in the 100 year-turnover pool
+                                                                         !! after the annual release for each compartment
+                                                                         !! @tex $(gC m^{-2})$ @endtex  
+                                                                         !! (0:100 input from year of land cover change), 
+                                                                         !! dimension(#pixels,0:100 years)
+!$OMP THREADPRIVATE(prod100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux10               !! Wood decomposition from the 10 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+                                                                         !! dimension(#pixels,0:10)  
+!$OMP THREADPRIVATE(flux10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux100              !! Wood decomposition from the 100 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+                                                                         !! dimension(#pixels,0:100)
+!$OMP THREADPRIVATE(flux100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: convflux             !! Release during first year following land cover change 
+                                                                         !! (paper, burned, etc...) 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex  
+!$OMP THREADPRIVATE(convflux)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod10         !! Total annual release from the 10 year-turnover pool
+                                                                         !! sum of flux10  
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(cflux_prod10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod100        !! Total annual release from the 100 year-turnover pool 
+                                                                         !! sum of flux100 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(cflux_prod100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: prod10_harvest       !! 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 wood harvest),
+                                                                         !! dimension(#pixels,0:10 years
+!$OMP THREADPRIVATE(prod10_harvest)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: prod100_harvest      !! 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 wood harvest), 
+                                                                         !! dimension(#pixels,0:100 years)
+!$OMP THREADPRIVATE(prod100_harvest)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux10_harvest       !! Wood decomposition from the 10 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+                                                                         !! dimension(#pixels,0:10)  
+!$OMP THREADPRIVATE(flux10_harvest)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux100_harvest      !! Wood decomposition from the 100 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+                                                                         !! dimension(#pixels,0:100)
+!$OMP THREADPRIVATE(flux100_harvest)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: convflux_harvest     !! Release during first year following wood harvest 
+                                                                         !! (paper, burned, etc...) 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex  
+!$OMP THREADPRIVATE(convflux_harvest)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod10_harvest !! Total annual release from the 10 year-turnover pool
+                                                                         !! sum of flux10  
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(cflux_prod10_harvest)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod100_harvest!! Total annual release from the 100 year-turnover pool 
+                                                                         !! sum of flux100 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(cflux_prod100_harvest)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: convfluxpft          !! Convflux per PFT                      
+!$OMP THREADPRIVATE(convfluxpft)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: fDeforestToProduct   !! Deforested biomass into product pool due to anthropogenic                                                                                                            
+                                                                         !! land use change                    
+!$OMP THREADPRIVATE(fDeforestToProduct)   
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: fLulccResidue        !! Carbon mass flux into soil and litter due to anthropogenic land use or land cover change                                                                          
+!$OMP THREADPRIVATE(fLulccResidue)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: fHarvestToProduct    !! Deforested biomass into product pool due to anthropogenic                                                                                       
+                                                                         !! land use
+!$OMP THREADPRIVATE(fHarvestToProduct)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:):: woodharvestpft       !! New year wood harvest per  PFT
+!$OMP THREADPRIVATE(woodharvestpft)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: harvest_above        !! Harvest of above ground biomass for agriculture -not 
+                                                                         !! just from land use change 
+                                                                         !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(harvest_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: carb_mass_total      !! Total on-site and off-site C pool 
+                                                                         !! @tex $(??gC m^{-2})$ @endtex                        
+!$OMP THREADPRIVATE(carb_mass_total)
+!---
+  REAL(r_std), SAVE                              :: tau_longterm
+!$OMP THREADPRIVATE(tau_longterm)
+  REAL(r_std),SAVE                               :: dt_days=zero         !! Time step of STOMATE (days) 
+!$OMP THREADPRIVATE(dt_days)
+  INTEGER(i_std),SAVE                            :: days_since_beg=0     !! Number of full days done since the start of the simulation
+!$OMP THREADPRIVATE(days_since_beg)
+
+!! liulyc this is from MICT but it is the days_since_beg above in TRUNK version
+  INTEGER(i_std),SAVE                            :: date=0               !! Date (days) 
+!$OMP THREADPRIVATE(date)
+!! liulyc
+
+  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
+!$OMP THREADPRIVATE(spinup_period)
+  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                                  :: l_first_stomate = .TRUE.!! Is this the first call of stomate?
+!$OMP THREADPRIVATE(l_first_stomate)
+  LOGICAL, SAVE                                  :: cumul_forcing=.FALSE.!! flag for cumul of forcing if teststomate
+!$OMP THREADPRIVATE(cumul_forcing)
+  LOGICAL, SAVE                                  :: cumul_Cforcing=.FALSE.  !! Flag, if internal parameter cumul_Cforcing is 
+                                                                            !! TRUE then ::nbyear (defined in run definition 
+                                                                            !! file will be forced to 1 later in this module. If 
+                                                                            !! FALSE the mean over ::nbyear is written in forcesoil
+!$OMP THREADPRIVATE(cumul_Cforcing)
+!---   
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: harvest_above_monthly   !! [??CHECK] post-processing - should be removed?
+!$OMP THREADPRIVATE(harvest_above_monthly)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod_monthly      !! [??CHECK] post-processing - should be removed?
+!$OMP THREADPRIVATE(cflux_prod_monthly)
+!---
+  INTEGER(i_std), SAVE                               :: global_years        !! Global counter of years (year)
+!$OMP THREADPRIVATE(global_years)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)           :: ok_equilibrium      !! Logical array marking the points where the resolution is ok 
+                                                                            !! (true/false)
+!$OMP THREADPRIVATE(ok_equilibrium)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)           :: carbon_eq           !! Logical array to mark the carbon pools at equilibrium ? 
+                                                                            !! If true, the job stops. (true/false)
+!$OMP THREADPRIVATE(carbon_eq)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)       :: nbp_accu            !! Accumulated Net Biospheric Production over the year (gC.m^2 )
+!$OMP THREADPRIVATE(nbp_accu)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)       :: nbp_flux            !! Net Biospheric Production (gC.m^2.day^{-1})
+!$OMP THREADPRIVATE(nbp_flux)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:)       :: matrixA             !! Matrix containing the fluxes between the carbon pools
+                                                                            !! per sechiba time step 
+                                                                            !! @tex $(gC.m^2.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(matrixA)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: vectorB             !! Vector containing the litter increase per sechiba time step
+                                                                            !! @tex $(gC m^{-2})$ @endtex
+!$OMP THREADPRIVATE(vectorB)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: MatrixV             !! Matrix containing the accumulated values of matrixA 
+!$OMP THREADPRIVATE(MatrixV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: VectorU             !! Matrix containing the accumulated values of VectorB
+!$OMP THREADPRIVATE(VectorU)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: MatrixW             !! Matrix containing the opposite of matrixA
+!$OMP THREADPRIVATE(MatrixW)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: previous_stock      !! Array containing the carbon stock calculated by the analytical
+                                                                            !! method in the previous resolution
+!$OMP THREADPRIVATE(previous_stock)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: current_stock       !! Array containing the carbon stock calculated by the analytical
+                                                                            !! method in the current resolution 
+!$OMP THREADPRIVATE(current_stock)
+  REAL(r_std), SAVE                                  :: eps_carbon          !! Stopping criterion for carbon pools (unitless,0-1)
+!$OMP THREADPRIVATE(eps_carbon)
+  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)
+
+ 
+PUBLIC clay_fm, humrel_daily_fm, litterhum_daily_fm, t2m_daily_fm, &
+   & t2m_min_daily_fm, tsurf_daily_fm, tsoil_daily_fm, soilhum_daily_fm, &
+   & precip_fm, gpp_daily_fm, veget_fm, veget_max_fm, lai_fm
+PUBLIC swdown_fm !! liulyc liulyw link to xuhui's crop
+PUBLIC  dt_days, days_since_beg, do_slow
+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,         temp_air,          &
+         lai,            veget,             veget_max,                       &
+         co2_flux,       co2_to_bm_radia,   fco2_lu,      deadleaf_cover,  assim_param, temp_growth )
+
+    IMPLICIT NONE
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpij             !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in)                       :: rest_id_stom      !! STOMATE's _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom      !! STOMATE's _history_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier(unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! The indices of the terrestrial pixels only (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: lalo              !! Geographical coordinates (latitude,longitude) for pixels (degrees) 
+    INTEGER(i_std),DIMENSION(kjpindex,NbNeighb),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)      :: temp_air          !! Air temperature at first atmospheric model layer (K)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: lai               !! Leaf area inex @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget             !! Fraction of vegetation type including 
+                                                                         !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget_max         !! Maximum fraction of vegetation type including 
+                                                                         !! non-biological fraction (unitless) 
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: co2_flux          !! CO2 flux between atmosphere and biosphere
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: co2_to_bm_radia   !! virtual gpp flux between atmosphere and biosphere
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: fco2_lu           !! CO2 flux between atmosphere and biosphere from land-use (without forest management)  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: deadleaf_cover    !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(out) :: assim_param !! min+max+opt temperatures (K) & vmax for photosynthesis  
+                                                                         !! @tex $(\mu mol m^{-2}s^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: temp_growth       !! Growth temperature (ÃÂ°C)  
+                                                                         !! Is equal to t2m_month 
+    !! 0.3 Local variables
+    REAL(r_std)                                   :: dt_days_read             !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.         !! Maximum STOMATE time step (days)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: rprof                    !! Coefficient of the exponential functions that 
+                                                                              !! relates root density to soil depth (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x              !! "Daily" gpp for teststomate  
+                                                                              !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: veget_cov                !! Fractional coverage: actually share of the pixel 
+                                                                              !! covered by a PFT (fraction of ground area), 
+                                                                              !! taking into account LAI ??(= grid scale fpc)?? 
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+
+    INTEGER(i_std)                                :: max_totsize              !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step            !! Memory management - memory required to store one 
+                                                                              !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp              !! Memory management - memory required to store one 
+                                                                              !! time step on all processors(Mb) 
+    INTEGER(i_std)                                :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh                   !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct                   !! 
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                     !! 
+
+
+!_ ================================================================================================================================
+    
+    !! 1. Initialize variable
+    !! Update flag
+    l_first_stomate = .FALSE.
+    
+    !! 1.1 Store current time step in a common variable
+    itime = kjit
+    
+    
+    !! 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.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
+       IF (printlev >=1) WRITE(numout,*) 'Spinup analytic is activated using eps_carbon=',&
+            eps_carbon, ' and spinup_period=',spinup_period
+    END IF
+    
+
+    !! 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, days_since_beg) !!xchen201712 !! liulyq  date is days_since_beg
+    
+    !! 1.4.3 Initial conditions
+    
+    !! 1.4.3.1 Read initial values for STOMATE's variables from the _restart_ file
+    ! ??Shouldn't this be included in stomate_init?? Looks like an initialization!
+    co2_flux(:,:) = zero
+    fco2_lu(:) = zero
+    
+    ! Get values from _restart_ file. Note that only ::kjpindex, ::index, ::lalo 
+    ! and ::resolution are input variables, all others are output variables.
+    CALL readstart &
+         (kjpindex, index, lalo, resolution, temp_air, &
+         dt_days_read, days_since_beg, & !!liulyq days_since_beg is date same as Xchen's code
+         ind, adapted, regenerate, &
+         humrel_daily, gdd_init_date, litterhum_daily, &
+         t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+         soilhum_daily, precip_daily, &
+         gpp_daily, npp_daily, turnover_daily, &
+         humrel_month, humrel_week, &
+         t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+         tsoil_month, soilhum_month, fireindex, firelitter, &
+         maxhumrel_lastyear, maxhumrel_thisyear, &
+         minhumrel_lastyear, minhumrel_thisyear, &
+         maxgppweek_lastyear, maxgppweek_thisyear, &
+         gdd0_lastyear, gdd0_thisyear, &
+         precip_lastyear, precip_thisyear, &
+         gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+         PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+         maxfpc_lastyear, maxfpc_thisyear, &
+         turnover_longterm, gpp_week, biomass, resp_maint_part, &
+         leaf_age, leaf_frac, &
+         senescence, when_growthinit, age, &
+         resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, co2_to_bm_dgvm, co2_to_bm_radia, &
+         veget_lastlight, everywhere, need_adjacent, RIP_time, &
+         time_hum_min, hum_min_dormance, &
+         litterpart, litter, dead_leaves, &
+         carbon, lignin_struc,turnover_time,&
+         prod10,prod100,flux10, flux100, &
+         convflux, cflux_prod10, cflux_prod100, &
+         prod10_harvest,prod100_harvest,flux10_harvest, flux100_harvest, &
+         convflux_harvest, cflux_prod10_harvest, cflux_prod100_harvest, &
+         convfluxpft, fDeforestToProduct, fLulccResidue,fHarvestToProduct, &
+         woodharvestpft, bm_to_litter, carb_mass_total, &
+         Tseason, Tseason_length, Tseason_tmp, &
+         Tmin_spring_time, begin_leaves, onset_date, &
+         global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+         MatrixV, VectorU, previous_stock, current_stock, assim_param)
+    
+    !! 1.4.5 Check time step
+       
+    !! 1.4.5.1 Allow STOMATE's time step to change although this is dangerous
+    IF (dt_days /= dt_days_read) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step changes:', &
+            & dt_days_read,' -> ',dt_days
+    ENDIF
+    
+    !! 1.4.5.2 Time step has to be a multiple of a full day
+    IF ( ( dt_days-REAL(NINT(dt_days),r_std) ) > min_stomate ) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step is not a mutiple of a full day:', &
+            & dt_days,' days.'
+       STOP
+    ENDIF
+    
+    !! 1.4.5.3 upper limit to STOMATE's time step
+    IF ( dt_days > max_dt_days ) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step exceeds the maximum value:', &
+            & dt_days,' days > ', max_dt_days, ' days.'  
+       STOP
+    ENDIF
+    
+    !! 1.4.5.4 STOMATE time step must not be less than the forcing time step
+    IF ( dt_sechiba > dt_days*one_day ) THEN
+       WRITE(numout,*) &
+            & 'slow_processes: STOMATE time step ::dt_days smaller than forcing time step ::dt_sechiba'
+       STOP
+    ENDIF
+    
+    !! 1.4.5.6 Final message on time step
+    IF (printlev >=2) 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))
+          IF (printlev>=2) 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(humrel_daily)*KIND(humrel_daily) &
+               +SIZE(litterhum_daily)*KIND(litterhum_daily) &
+               +SIZE(t2m_daily)*KIND(t2m_daily) &
+               +SIZE(t2m_min_daily)*KIND(t2m_min_daily) &
+               +SIZE(tsurf_daily)*KIND(tsurf_daily) &
+               +SIZE(tsoil_daily)*KIND(tsoil_daily) &
+               +SIZE(soilhum_daily)*KIND(soilhum_daily) &
+               +SIZE(precip_daily)*KIND(precip_daily) &
+               +SIZE(gpp_daily_x)*KIND(gpp_daily_x) &
+               +SIZE(veget)*KIND(veget) &
+               +SIZE(veget_max)*KIND(veget_max) &
+               +SIZE(lai)*KIND(lai)
+          
+          ! Totsize_1step is the size on a single processor, sum
+          ! all processors and send to all processors
+          CALL reduce_sum(totsize_1step,totsize_tmp)
+          CALL bcast(totsize_tmp)
+          totsize_1step=totsize_tmp
+          
+          ! Total number of forcing steps
+          nsft = INT(one_year/(dt_stomate/one_day))
+          
+          ! Number of forcing steps in memory
+          nsfm = MIN(nsft, &
+               MAX(1,NINT( REAL(max_totsize,r_std) &
+               /REAL(totsize_1step,r_std))))
+            
+             
+          !! 1.6.4.2 Allocate memory for variables containing forcing data  
+          ! and initialize variables (set to zero).
+          CALL init_forcing (kjpindex,nsfm,nsft)
+          
+          ! Indexing for writing forcing file
+          isf(:) = (/ (i,i=1,nsfm) /)
+          nf_written(:) = .FALSE.
+          nf_cumul(:) = 0
+          iisf = 0
+          
+          !! 1.6.4.3 Create netcdf file
+          ! Create, define and populate a netcdf file containing the forcing data.
+          ! For the root processor only (parallel computing). NF90_ are functions
+          ! from and external library.  
+          IF (is_root_prc) THEN
+             
+             ! Create new netCDF dataset
+             ier = NF90_CREATE (TRIM(forcing_name),NF90_SHARE,forcing_id)
+             
+             ! Add variable attribute
+             ! Note ::iim_g and ::jjm_g are dimensions of the global field and 
+             ! ::nbp_glo is the number of global continental points
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dt_sechiba',dt_sechiba)
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dt_stomate',dt_stomate)
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'nsft',REAL(nsft,r_std))
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'kjpij',REAL(iim_g*jjm_g,r_std))
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'kjpindex',REAL(nbp_glo,r_std))
+             
+             ! Add new dimension
+             ier = NF90_DEF_DIM (forcing_id,'points',nbp_glo,d_id(1))
+             ier = NF90_DEF_DIM (forcing_id,'layers',nslm,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,'humrel', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'litterhum', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'t2m', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'t2m_min', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'tsurf', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'tsoil', &
+                  r_typ,(/ d_id(1),d_id(2),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'soilhum', &
+                  r_typ,(/ d_id(1),d_id(2),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'precip', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'gpp', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'veget', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'veget_max', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'lai', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_ENDDEF (forcing_id)
+             
+             ! Given the name of a varaible, nf90_inq_varid finds the variable 
+             ! ID (::vid). Put data value(s) into variable ::vid
+             ier = NF90_INQ_VARID (forcing_id,'points',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  (/(REAL(i,r_std),i=1,nbp_glo) /))
+             ier = NF90_INQ_VARID (forcing_id,'layers',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nslm)/))
+             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
+       IF (printlev>=2) WRITE(numout,*) 'Time step of soil forcing (d): ',dt_forcesoil
+       
+       ! Allocate memory for the forcing variables of soil dynamics
+       ALLOCATE( nforce(nparan*nbyear))
+       nforce(:) = 0
+       ALLOCATE(control_moist(kjpindex,nlevs,nparan*nbyear))
+       ALLOCATE(npp_equil(kjpindex,nparan*nbyear))
+       ALLOCATE(npp_tot(kjpindex))
+       ALLOCATE(control_temp(kjpindex,nlevs,nparan*nbyear))
+       ALLOCATE(soilcarbon_input(kjpindex,ncarb,nvm,nparan*nbyear)) 
+       
+       ! Initialize variables, set to zero
+       control_moist(:,:,:) = zero
+       npp_equil(:,:) = zero
+       npp_tot(:) = zero
+       control_temp(:,:,:) = zero
+       soilcarbon_input(:,:,:,:) = zero
+       
+    ENDIF ! Cforcing_name) /= 'NONE'
+    
+    !! 1.4.8 Calculate STOMATE's vegetation fractions from veget, veget_max
+    DO j=1,nvm
+       WHERE ((1.-totfrac_nobio(:)) > min_sechiba)       
+          ! Pixels with vegetation
+          veget_cov(:,j) = veget(:,j)/( 1.-totfrac_nobio(:) )
+          veget_cov_max(:,j) = veget_max(:,j)/( 1.-totfrac_nobio(:) )
+       ELSEWHERE
+          ! Pixels without vegetation
+          veget_cov(:,j) = zero
+          veget_cov_max(:,j) = zero
+       ENDWHERE
+    ENDDO ! Loop over PFTs
+
+    !! 1.4.9 Initialize non-zero variables
+    CALL stomate_var_init &
+         (kjpindex, veget_cov_max, leaf_age, leaf_frac, &
+         dead_leaves, &
+         veget, lai, deadleaf_cover, assim_param)
+    
+    ! Initialize land cover change variable
+    ! ??Should be integrated in the subroutine?? 
+    harvest_above(:) = zero
+    
+    ! Initialize temp_growth
+    temp_growth(:)=t2m_month(:)-tp_00 
+
+      
+  END SUBROUTINE stomate_initialize
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_main
+!!
+!>\BRIEF        Manages variable initialisation, reading and writing forcing 
+!! files, aggregating data at stomate's time step (dt_stomate), aggregating data
+!! at longer time scale (i.e. for phenology) and uses these forcing to calculate
+!! CO2 fluxes (NPP and respirations) and C-pools (litter, soil, biomass, ...)
+!!
+!! DESCRIPTION  : The subroutine manages 
+!! divers tasks:
+!! (1) Initializing all variables of stomate (first call)
+!! (2) Reading and writing forcing data (last call)
+!! (3) Adding CO2 fluxes to the IPCC history files
+!! (4) Converting the time steps of variables to maintain consistency between
+!! sechiba and stomate
+!! (5) Use these variables to call stomate_lpj, maint_respiration, littercalc,
+!! soilcarbon. The called subroutines handle: climate constraints 
+!! for PFTs, PFT dynamics, Phenology, Allocation, NPP (based on GPP and
+!! authothropic respiration), fire, mortality, vmax, assimilation temperatures,
+!! all turnover processes, light competition, sapling establishment, lai,  
+!! land cover change and litter and soil dynamics.
+!! (6) Use the spin-up method developed by Lardy (2011)(only if SPINUP_ANALYTIC 
+!! is set to TRUE).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): deadleaf_cover, assim_param, lai, height, veget, 
+!! veget_max, resp_maint, 
+!! resp_hetero,resp_growth, co2_flux, fco2_lu.
+!!
+!! REFERENCES	: 
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!! \includegraphics[scale=0.5]{stomatemainflow.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+  
+SUBROUTINE stomate_main &
+       & (kjit, kjpij, kjpindex, &
+       &  index, lalo, neighbours, resolution, contfrac, totfrac_nobio, clay, &
+       &  temp_air, temp_sol, stempdiag, &
+       &  humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, &
+       &  gpp, deadleaf_cover, assim_param, &
+       &  lai, &
+!!@xchen lai_cl1-4 of leaf age class 1-4 for claculating the PC in Wu's paper
+       &  lai_cl1, lai_cl2, lai_cl3, lai_cl4, &
+       &  laitop, laidow, VPD, ave_VPD, &
+!!@xchen vcmax_cl1, vcmax_cl2,vcmax_cl3,vcmax_cl4  liuly                                                                     
+       &  vcmax_cl1, vcmax_cl2, vcmax_cl3, vcmax_cl4, &
+       
+       &  frac_age, height, veget, veget_max, &
+       &  veget_max_new, woodharvest, totfrac_nobio_new, fraclut, &
+       &  rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+       &  co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth,co2_to_bm_radia,temp_growth,&
+       & swdown) !!liulyc liulyw xuhui's crop but xchen used it.
+    
+    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,NbNeighb),INTENT(in) :: neighbours !! Neighoring grid points if land for the DGVM 
+                                                                         !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: lalo              !! Geographical coordinates (latitude,longitude) 
+                                                                         !! for pixels (degrees) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: resolution        !! Size in x an y of the grid (m) - surface area of 
+                                                                         !! the gridbox 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: contfrac          !! Fraction of continent in the grid cell (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio     !! Fraction of grid cell covered by lakes, land 
+                                                                         !! ice, cities, ... (unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: humrel            !! Relative humidity ("moisture availability") 
+                                                                         !! (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: temp_air          !! Air temperature at first atmosperic model layer (K)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: temp_sol          !! Surface temperature (K)
+    REAL(r_std),DIMENSION(kjpindex,nslm),INTENT(in) :: stempdiag         !! Soil temperature (K)
+    REAL(r_std),DIMENSION(kjpindex,nslm),INTENT(in) :: shumdiag          !! Relative soil moisture (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: litterhumdiag     !! Litter humidity (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: precip_rain       !! Rain precipitation  
+                                                                         !! @tex $(mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: precip_snow       !! Snow precipitation  
+                                                                         !! @tex $(mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: gpp               !! GPP of total ground area  
+                                                                         !! @tex $(gC m^{-2} time step^{-1})$ @endtex 
+                                                                         !! Calculated in sechiba, account for vegetation 
+                                                                         !! cover and effective time step to obtain ::gpp_d 
+!! liulyc
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: lai_cl1          !!@xchen lai of leaf class age 1-4 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: lai_cl2          !! 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: lai_cl3          !! 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: lai_cl4          !!
+!! xchen add vpd for gpp simulation in Amazon                                   
+    REAL(r_std),DIMENSION(kjpindex),INTENT (in)     :: VPD               !! Vapor Pressure Deficit (kPa)
+    REAL(r_std),DIMENSION(kjpindex),INTENT (out)    :: ave_VPD           !! Vapor Pressure Deficit (kPa)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)   :: laitop        !!xchen Wu (science, 2016) sunlit leaf area index @tex ($m^2 m^{-2}$) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)   :: laidow        !!xchen Wu (science 2016) shade leaf area index @tex ($m^2 m^{-2}$) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: vcmax_cl1        !!@xchen vcmax of leaf class age 1-4 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: vcmax_cl2        !!     
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: vcmax_cl3        !!     
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)  :: vcmax_cl4        !!   
+
+    REAL(r_std), DIMENSION(kjpindex), INTENT(IN)     :: swdown           !! xuhui's crop but xchen used it 
+!! liulyc above
+
+
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget_max_new     !! New "maximal" coverage fraction of a PFT: only if 
+                                                                         !! vegetation is updated in slowproc
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: woodharvest       !! Harvested wood biomass (gC m-2 yr-1)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio_new !! New fraction of nobio per gridcell
+    REAL(r_std),DIMENSION(kjpindex, nlut),INTENT(in):: fraclut           !! Fraction of landuse tiles
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION(kjpindex,nvm)  :: delta_turnover          !!xchen1111
+
+    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,nvm),INTENT(out) :: co2_to_bm_radia   !! Virtual gpp created for equilibrium of carbon mass  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: temp_growth       !! Growth temperature (ÃÂ°C)  
+                                                                         !! Is equal to t2m_month 
+
+    !! 0.3 Modified
+   
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: lai            !! Leaf area inex @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)          :: veget          !! Fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: veget_max      !! Maximum fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: height         !! Height of vegetation (m)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(inout) :: assim_param    !! min+max+opt temperatures (K) & vmax for 
+                                                                              !! photosynthesis  
+                                                                              !! @tex $(\mu mol m^{-2}s^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(inout)           :: deadleaf_cover !! Fraction of soil covered by dead leaves 
+                                                                              !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(inout):: frac_age    !! Age efficacity from STOMATE 
+
+    !! 0.4 local variables
+    
+    REAL(r_std)                                   :: dt_days_read             !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.         !! Maximum STOMATE time step (days)
+    REAL(r_std)                                   :: hist_days                !! Writing frequency for history file (days)
+    REAL(r_std),DIMENSION(0:nslm)                 :: 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  
+!!xchen
+    REAL(r_std), DIMENSION(kjpindex)              :: VPD_d                    !! Vapor Pressure Deficit (kPa)
+
+    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)           :: veget_cov_max_new        !! New value for maximal fractional coverage (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: vcmax                    !! Maximum rate of carboxylation
+                                                                              !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nlevs)         :: control_moist_inst       !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nlevs)         :: control_temp_inst        !! Temperature control of heterotrophic 
+                                                                              !! respiration, above and below (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex,ncarb,nvm)     :: soilcarbon_input_inst    !! Quantity of carbon going into carbon pools from 
+                                                                              !! litter decomposition 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+    
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+    REAL(r_std)                                   :: 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_nep_monthly          !! Integrated nep_monthly over all grid-cells on local domain
+    REAL(r_std)                                   :: net_nep_monthly_sum      !! Integrated nep_monthly over all grid-cells on total domain(global)
+    REAL(r_std),DIMENSION(nbp_glo)                :: clay_g                   !! Clay fraction of soil (0-1, unitless), parallel 
+                                                                              !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: soilcarbon_input_g       !! Quantity of carbon going into carbon pools from 
+                                                                              !! litter decomposition  
+                                                                              !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_moist_g          !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_temp_g           !! Temperature control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)        :: npp_equil_g              !! Equilibrium NPP written to forcesoil 
+                                                                              !! @tex $(gC m^{-2} year^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+
+    REAL(r_std)                                   :: net_cflux_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_cflux_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_sum !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_tot !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std), DIMENSION(kjpindex,nvm,nbpools)  :: carbon_stock                  !! Array containing the carbon stock for each pool
+                                                                                   !! used by ORCHIDEE
+
+!_ ================================================================================================================================
+    
+  !! 1. Initialize variables
+
+    !! 1.1 Store current time step in a common variable
+    itime = kjit
+   
+    !! 1.3 PFT rooting depth across pixels, humescte is pre-defined 
+    ! (constantes_veg.f90). It is defined as the coefficient of an exponential 
+    ! function relating root density to depth 
+    DO j=1,nvm
+       rprof(:,j) = 1./humcste(j)
+    ENDDO
+    
+    !! 1.4 Initialize first call
+    ! Set growth respiration to zero
+    resp_growth=zero
+
+    ! Check that initialization is done
+    IF (l_first_stomate) CALL ipslerr_p(3,'stomate_main','Initialization not yet done.','','')
+    
+    IF (printlev >= 4) THEN
+       WRITE(numout,*) 'stomate_main: date=',days_since_beg,' ymds=', year_end, month_end, day_end, sec_end, &
+            ' itime=', itime, ' do_slow=',do_slow
+    ENDIF
+
+!! 3. Special treatment for some input arrays.
+    
+    !! 3.1 Sum of liquid and solid precipitation
+    precip(:) = ( precip_rain(:) + precip_snow(:) )*one_day/dt_sechiba
+    
+    !! 3.2 Calculate STOMATE's vegetation fractions from veget and veget_max
+    DO j=1,nvm 
+       WHERE ((1.-totfrac_nobio(:)) > min_sechiba)
+          ! Pixels with vegetation
+          veget_cov(:,j) = veget(:,j)/( 1.-totfrac_nobio(:) )
+          veget_cov_max(:,j) = veget_max(:,j)/( 1.-totfrac_nobio(:) )
+       ELSEWHERE
+          ! Pixels without vegetation
+          veget_cov(:,j) = zero
+          veget_cov_max(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    IF ( do_now_stomate_lcchange ) THEN
+       DO j=1,nvm
+          WHERE ((1.-totfrac_nobio_new(:)) > min_sechiba)
+             ! Pixels with vegetation
+             veget_cov_max_new(:,j) = veget_max_new(:,j)/( 1.-totfrac_nobio_new(:) )
+          ELSEWHERE
+             ! Pixels without vegetation
+             veget_cov_max_new(:,j) = zero
+          ENDWHERE
+       ENDDO
+    ENDIF
+
+    !! 3.3 Adjust time step of GPP 
+    ! No GPP for bare soil
+    gpp_d(:,1) = zero
+    ! GPP per PFT
+    DO j = 2,nvm   
+       WHERE (veget_cov_max(:,j) > min_stomate)
+          ! The PFT is available on the pixel
+          gpp_d(:,j) =  gpp(:,j)/ veget_cov_max(:,j)* one_day/dt_sechiba  
+       ELSEWHERE
+          ! The PFT is absent on the pixel
+          gpp_d(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !!xchen
+    VPD_d(:) = VPD(:)/10* one_day/dt_sechiba
+
+  !! 4. Calculate variables for dt_stomate (i.e. "daily")
+
+    ! Note: If dt_days /= 1, then variables 'xx_daily' (eg. half-daily or bi-daily) are by definition
+    ! not expressed on a daily basis. This is not a problem but could be
+    ! confusing
+
+    !! 4.1 Accumulate instantaneous variables (do_slow=.FALSE.) 
+    ! Accumulate instantaneous variables (do_slow=.FALSE.) and eventually 
+    ! calculate daily mean value (do_slow=.TRUE.) 
+    CALL stomate_accu (do_slow, humrel,        humrel_daily)
+    CALL stomate_accu (do_slow, litterhumdiag, litterhum_daily)
+    CALL stomate_accu (do_slow, temp_air,      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)
+
+    !!xchen
+    CALL stomate_accu ( do_slow, VPD_d,         VPD_daily)                     
+    CALL stomate_accu ( do_slow, swdown,        swdown_daily) 
+   
+    !! 4.2 Daily minimum temperature
+    t2m_min_daily(:) = MIN( temp_air(:), t2m_min_daily(:) )
+
+    !! 4.3 Calculate maintenance respiration
+    ! Note: lai is passed as output argument to overcome previous problems with 
+    ! natural and agricultural vegetation types. 
+    CALL maint_respiration &
+         & (kjpindex,lai,temp_air,t2m_longterm,stempdiag,height,veget_cov_max, &
+         & rprof,biomass,resp_maint_part_radia)
+    
+    ! Aggregate maintenance respiration across the different plant parts 
+    resp_maint_radia(:,:) = zero
+    DO j=2,nvm
+       DO k= 1, nparts
+          resp_maint_radia(:,j) = resp_maint_radia(:,j) &
+               & + resp_maint_part_radia(:,j,k)
+       ENDDO
+    ENDDO
+    
+    ! Maintenance respiration separated by plant parts
+    resp_maint_part(:,:,:) = resp_maint_part(:,:,:) &
+         & + resp_maint_part_radia(:,:,:)
+    
+    !! 4.4 Litter dynamics and litter heterothropic respiration 
+    ! Including: litter update, lignin content, PFT parts, litter decay,
+    ! litter heterotrophic respiration, dead leaf soil cover.
+    ! Note: there is no vertical discretisation in the soil for litter decay.
+    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, &
+         litterpart, litter, dead_leaves, lignin_struc, &
+         deadleaf_cover, resp_hetero_litter, &
+         soilcarbon_input_inst, control_temp_inst, control_moist_inst, &
+         matrixA, vectorB)
+    
+    ! Heterothropic litter respiration during time step ::dt_sechiba @tex $(gC m^{-2})$ @endtex
+    resp_hetero_litter(:,:) = resp_hetero_litter(:,:) * dt_sechiba/one_day
+    
+    !! 4.5 Soil carbon dynamics and soil heterotrophic respiration
+    ! Note: there is no vertical discretisation in the soil for litter decay.
+    CALL soilcarbon (kjpindex, clay, &
+         soilcarbon_input_inst, control_temp_inst, control_moist_inst, veget_cov_max, &
+         carbon, resp_hetero_soil, matrixA)
+    
+    ! Heterothropic soil respiration during time step ::dt_sechiba @tex $(gC m^{-2})$ @endtex 
+    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(:,:)
+    
+    !! 4.6 Accumulate instantaneous variables (do_slow=.FALSE.) 
+    ! Accumulate instantaneous variables (do_slow=.FALSE.) and eventually 
+    ! calculate daily mean value (do_slow=.TRUE.) 
+    CALL stomate_accu (do_slow, control_moist_inst, control_moist_daily)
+    CALL stomate_accu (do_slow, control_temp_inst,  control_temp_daily)
+    CALL stomate_accu (do_slow, soilcarbon_input_inst, soilcarbon_input_daily)
+    
+!! 5. Daily processes - performed at the end of the day
+    
+    IF (do_slow) THEN
+     WRITE(numout,*) "Number of days date: ", date !liulyc
+     WRITE(numout,*) "Number of days days_since_beg: ", days_since_beg !liulyc
+     
+
+       !! 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
+          !!xchen
+          lai_cl1(:,ibare_sechiba) = zero  
+          lai_cl2(:,ibare_sechiba) = zero                                           
+          lai_cl3(:,ibare_sechiba) = zero                                           
+          lai_cl4(:,ibare_sechiba) = zero                                          
+          laitop(:,ibare_sechiba) = zero                                        
+          laidow(:,ibare_sechiba) = zero  
+          !! liulyq
+
+          ! lai for all PFTs
+          DO j = 2, nvm
+             lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+          ENDDO
+          frac_age(:,:,:) = leaf_frac(:,:,:)
+       ELSE 
+          ! 5.1.2 Use a prescribed lai
+          ! WARNING: code in setlai is identical to the lines above
+          ! Update subroutine if LAI has to be forced 
+          CALL  setlai(kjpindex,lai) 
+          !! liulyq add cl1-4?
+          frac_age(:,:,:) = zero
+       ENDIF
+
+       !! 5.2 Calculate long-term "meteorological" and biological parameters
+       ! mainly in support of calculating phenology. If LastTsYear=.TRUE.
+       ! annual values are update (i.e. xx_lastyear).
+       CALL season &
+            &          (kjpindex, dt_days, &
+            &           veget_cov, veget_cov_max, &
+            &           humrel_daily, t2m_daily, tsoil_daily, soilhum_daily, lalo, &
+            &           precip_daily, npp_daily, biomass, &
+            &           turnover_daily, gpp_daily, when_growthinit, &
+            &           VPD_daily, VPD_week, swdown_daily, swdown_week, & !!xchen
+            &           precip_week, & !liulye
+            &           maxhumrel_lastyear, maxhumrel_thisyear, &
+            &           minhumrel_lastyear, minhumrel_thisyear, &
+            &           maxgppweek_lastyear, maxgppweek_thisyear, &
+            &           gdd0_lastyear, gdd0_thisyear, &
+            &           precip_lastyear, precip_thisyear, &
+            &           lm_lastyearmax, lm_thisyearmax, &
+            &           maxfpc_lastyear, maxfpc_thisyear, &
+            &           humrel_month, humrel_week, t2m_longterm, tau_longterm, &
+            &           t2m_month, t2m_week, tsoil_month, soilhum_month, &
+            &           npp_longterm, turnover_longterm, gpp_week, &
+            &           gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &           time_hum_min, hum_min_dormance, gdd_init_date, &
+            &           gdd_from_growthinit, herbivores, &
+            &           Tseason, Tseason_length, Tseason_tmp, &
+            &           Tmin_spring_time, t2m_min_daily, begin_leaves, onset_date)
+       
+       !! 5.3 Use all processes included in stomate
+
+       !! 5.3.1  Activate stomate processes 
+       ! Activate stomate processes (the complete list of processes depends 
+       ! on whether the DGVM is used or not). Processes include: climate constraints 
+       ! for PFTs, PFT dynamics, Phenology, Allocation, NPP (based on GPP and
+       ! authothropic respiration), fire, mortality, vmax, assimilation temperatures,
+       ! all turnover processes, light competition, sapling establishment, lai and 
+       ! land cover change.
+       CALL StomateLpj &
+            &            (kjpindex, dt_days, &
+            &             neighbours, resolution, &
+            &             clay, herbivores, &
+            &             tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
+            &             litterhum_daily, soilhum_daily, &
+            &             maxhumrel_lastyear, minhumrel_lastyear, &
+            &             gdd0_lastyear, precip_lastyear, &
+            &             humrel_month, humrel_week, t2m_longterm, t2m_month, t2m_week, &
+            &             tsoil_month, soilhum_month, &
+            &             gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &             turnover_longterm, gpp_daily, &
+!! liuly
+            &             gpp_week, VPD_daily, VPD_week, swdown_daily, swdown_week,& !!xchen
+!! liuly above
+            &             days_since_beg, precip_week,& !liulyc add date, liulye date should be days_since_beg
+
+            &             time_hum_min, maxfpc_lastyear, resp_maint_part,&
+            &             PFTpresent, age, fireindex, firelitter, &
+            &             leaf_age, leaf_frac, biomass, ind, adapted, regenerate, &
+            &             senescence, when_growthinit, litterpart, litter, &
+            &             dead_leaves, carbon, lignin_struc, &
+            &             veget_cov_max, veget_cov_max_new, woodharvest, fraclut, npp_longterm, lm_lastyearmax, &
+            &             veget_lastlight, everywhere, need_adjacent, RIP_time, &
+            &             lai,&
+!! @xchen lai for leaf age class1-4 for caculating PC in Wu's science paper     
+            &             lai_cl1,lai_cl2,lai_cl3,lai_cl4,laitop,laidow,VPD,ave_VPD, swdown, & 
+!! liulyq swdown?
+            &             rprof,npp_daily, turnover_daily, turnover_time,&
+            &             control_moist_inst, control_temp_inst, soilcarbon_input_inst, &
+            &             co2_to_bm_dgvm, co2_fire, &
+            &             resp_hetero_d, resp_maint_d, resp_growth_d, &
+            &             height, deadleaf_cover, vcmax, &
+!!@xchen1111
+            &             vcmax_cl1, vcmax_cl2,vcmax_cl3,vcmax_cl4, delta_turnover,&
+
+            &             bm_to_litter,&
+            &             prod10, prod100, flux10, flux100, &
+            &             convflux, cflux_prod10, cflux_prod100, &
+            &             prod10_harvest, prod100_harvest, flux10_harvest, flux100_harvest, &
+            &             convflux_harvest, cflux_prod10_harvest, cflux_prod100_harvest, woodharvestpft, & 
+            &             convfluxpft, fDeforestToProduct, fLulccResidue,fHarvestToProduct, &
+            &             harvest_above, carb_mass_total, &
+            &             fpc_max, matrixA, &
+            &             Tseason, Tmin_spring_time, begin_leaves, onset_date)
+       
+       !! 5.3.2 Calculate the total CO2 flux from land use change
+       fco2_lu(:) = convflux(:) &
+            &             + cflux_prod10(:)  &
+            &             + cflux_prod100(:) &
+            &             + harvest_above(:) &
+            &             + convflux_harvest(:) &
+            &             + cflux_prod10_harvest(:)  &
+            &             + cflux_prod100_harvest(:)
+       
+       !! 5.4 Calculate veget and veget_max
+       veget_max(:,:) = zero 
+       DO j = 1, nvm
+          veget_max(:,j) = veget_max(:,j) + &
+               & veget_cov_max(:,j) * ( 1.-totfrac_nobio(:) )
+       ENDDO
+       
+       !! 5.5 Photosynthesis parameters
+       assim_param(:,:,ivcmax) = zero
+       DO j = 2,nvm
+          assim_param(:,j,ivcmax) = vcmax(:,j)
+       ENDDO
+       
+       !! 5.6 Update forcing variables for soil carbon
+       IF (TRIM(Cforcing_name) /= 'NONE') THEN
+          npp_tot(:) = 0
+          DO j=2,nvm
+             npp_tot(:) = npp_tot(:) + npp_daily(:,j)
+          ENDDO
+          ! ::nbyear Number of years saved for carbon spinup
+          sf_time = MODULO(REAL(days_since_beg,r_std)-1,one_year*REAL(nbyear,r_std))
+          iatt=FLOOR(sf_time/dt_forcesoil) + 1
+          IF (iatt == 0) iatt = iatt_old + 1
+          IF ((iatt<iatt_old) .and. (.not. cumul_Cforcing)) THEN
+             nforce(:)=0
+             soilcarbon_input(:,:,:,:) = zero
+             control_moist(:,:,:) = zero
+             control_temp(:,:,:) = zero
+             npp_equil(:,:) = zero
+          ENDIF
+          iatt_old = iatt
+          ! Update forcing
+          nforce(iatt) = nforce(iatt)+1
+          soilcarbon_input(:,:,:,iatt) = soilcarbon_input(:,:,:,iatt) + soilcarbon_input_daily(:,:,:)
+          control_moist(:,:,iatt) = control_moist(:,:,iatt) + control_moist_daily(:,:)
+          control_temp(:,:,iatt) = control_temp(:,:,iatt) + control_temp_daily(:,:)
+          npp_equil(:,iatt) = npp_equil(:,iatt) + npp_tot(:)
+       ENDIF
+       
+       !! 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.)
+             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.)
+            !! liulyc liulyw link to xuhui's crop
+             swdown_fm(:,iisf) = &
+                  & (xn*swdown_fm(:,iisf)+swdown(:))/(xn+1.)
+          ELSE
+             ! Here we just calculate the values
+             clay_fm(:,iisf) = clay(:)
+             humrel_daily_fm(:,:,iisf) = humrel_daily(:,:)
+             litterhum_daily_fm(:,iisf) = litterhum_daily(:)
+             t2m_daily_fm(:,iisf) = t2m_daily(:)
+             t2m_min_daily_fm(:,iisf) =t2m_min_daily(:)
+             tsurf_daily_fm(:,iisf) = tsurf_daily(:)
+             tsoil_daily_fm(:,:,iisf) =tsoil_daily(:,:)
+             soilhum_daily_fm(:,:,iisf) =soilhum_daily(:,:)
+             precip_fm(:,iisf) = precip_daily(:)
+             gpp_daily_fm(:,:,iisf) =gpp_daily_x(:,:)
+             veget_fm(:,:,iisf) = veget(:,:)
+             veget_max_fm(:,:,iisf) =veget_max(:,:)
+             lai_fm(:,:,iisf) =lai(:,:)
+            !! liulyc liulyw link to xuhui's crop
+             swdown_fm(:,iisf) =swdown(:)
+          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 diagnostics
+       ! CO2 flux in @tex $gC m^{-2} s^{-1}$ @endtex (positive from atmosphere to land) is sum of:
+       !   (1) co2 taken up by photosyntyhesis + (2) co2 taken up in the DGVM to establish saplings 
+       ! - (3) plants maintenance respiration  - (4) plants growth respiration
+       ! - (5) heterotrophic respiration from ground
+       ! - (6) co2 emission from fire
+       ! co2_to_bm is not added as it is already encounted in gpp
+       nep_daily(:,:)= gpp_daily(:,:)       &
+                     - resp_maint_d(:,:)  - resp_growth_d(:,:)   &
+                     - resp_hetero_d(:,:) - co2_fire(:,:) 
+
+       CALL xios_orchidee_send_field("nep",SUM(nep_daily*veget_cov_max,dim=2)/1e3/one_day)
+       CALL xios_orchidee_send_field("rhSoil",SUM(resp_hetero_soil*veget_cov_max,dim=2)/1e3)
+       CALL xios_orchidee_send_field("rhLitter",SUM(resp_hetero_litter*veget_cov_max,dim=2)/1e3)
+       
+
+       IF ( hist_id_stom_IPCC > 0 ) THEN
+          vartmp(:) = SUM(nep_daily*veget_cov_max,dim=2)/1e3/one_day*contfrac
+          CALL histwrite_p (hist_id_stom_IPCC, "nep", itime, &
+               vartmp, kjpindex, hori_index)
+       ENDIF
+
+       ! Cumulate nep, harvest and land use change fluxes
+       nep_monthly(:,:) = nep_monthly(:,:) + nep_daily(:,:)
+       harvest_above_monthly(:) = harvest_above_monthly(:) + harvest_above(:)
+       cflux_prod_monthly(:) = cflux_prod_monthly(:) + convflux(:) + & 
+        & cflux_prod10(:) + cflux_prod100(:) + convflux_harvest(:) + & 
+        & cflux_prod10_harvest(:) + cflux_prod100_harvest(:)
+      
+       !! 5.10 Compute monthly CO2 fluxes 
+       IF ( LastTsMonth ) THEN
+          !! 5.10.1 Write history file for monthly fluxes
+          CALL histwrite_p (hist_id_stomate, 'CO2FLUX', itime, &
+               nep_monthly, kjpindex*nvm, horipft_index)
+          
+          ! Integrate nep_monthly over all grid-cells on local domain
+          net_nep_monthly = zero
+          DO ji=1,kjpindex
+             DO j=2,nvm
+                net_nep_monthly = net_nep_monthly + &
+                     nep_monthly(ji,j)*resolution(ji,1)*resolution(ji,2)*contfrac(ji)*veget_cov_max(ji,j)
+             ENDDO
+          ENDDO
+          ! Change unit from gC/m2 grid-cell into PgC/m2 grid-cell
+          net_nep_monthly = net_nep_monthly*1e-15
+
+     
+          !! 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
+          ! local variable, the second argument is the global variable. bcast send it to all processors.
+          net_cflux_prod_monthly_sum = &
+              &  SUM(cflux_prod_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15
+          CALL reduce_sum(net_cflux_prod_monthly_sum,net_cflux_prod_monthly_tot)
+          CALL bcast(net_cflux_prod_monthly_tot)
+          net_harvest_above_monthly_sum = &
+             &   SUM(harvest_above_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15
+          CALL reduce_sum(net_harvest_above_monthly_sum,net_harvest_above_monthly_tot)
+          CALL bcast(net_harvest_above_monthly_tot)
+          CALL reduce_sum(net_nep_monthly,net_nep_monthly_sum)
+          CALL bcast(net_nep_monthly_sum)
+          net_biosp_prod_monthly_tot =  net_cflux_prod_monthly_tot + net_harvest_above_monthly_tot - net_nep_monthly_sum
+          
+          WRITE(numout,9010) 'GLOBAL net_cflux_prod_monthly    (Peta gC/month)  = ',net_cflux_prod_monthly_tot
+          WRITE(numout,9010) 'GLOBAL net_harvest_above_monthly (Peta gC/month)  = ',net_harvest_above_monthly_tot
+          WRITE(numout,9010) 'GLOBAL net_nep_monthly           (Peta gC/month)  = ',net_nep_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
+          nep_monthly(:,:) = zero
+          harvest_above_monthly(:) = zero
+          cflux_prod_monthly(:)    = zero
+
+       ENDIF ! Monthly processes - at the end of the month
+       
+       IF (spinup_analytic) THEN
+          nbp_accu(:) = nbp_accu(:) + (SUM(nep_daily(:,:) * veget_max(:,:),dim=2) - (convflux(:) + cflux_prod10(:) + &
+                    cflux_prod100(:)) - (convflux_harvest(:) + cflux_prod10_harvest(:) + &
+                    cflux_prod100_harvest(:))  - harvest_above(:))/1e3 
+       ENDIF
+
+       !! 5.11 Reset daily variables
+       humrel_daily(:,:) = zero
+       litterhum_daily(:) = zero
+       t2m_daily(:) = zero
+       t2m_min_daily(:) = large_value
+       tsurf_daily(:) = zero
+       tsoil_daily(:,:) = zero
+       soilhum_daily(:,:) = zero
+       precip_daily(:) = zero
+       gpp_daily(:,:) = zero
+       VPD_daily(:) = zero !!xchen
+       swdown_daily(:) = zero !!xchen 
+       resp_maint_part(:,:,:)=zero
+       resp_hetero_d=zero
+       IF (printlev >= 3) THEN
+          WRITE(numout,*) 'stomate_main: daily processes done'
+       ENDIF
+
+    ENDIF  ! Daily processes - at the end of the day
+    
+  !! 6. Outputs from Stomate
+
+    ! co2_flux receives a value from STOMATE only if STOMATE is activated.
+    ! Otherwise, the calling hydrological module must do this itself.
+
+    !! 6.1 Respiration and fluxes
+    resp_maint(:,:) = resp_maint_radia(:,:)*veget_cov_max(:,:)
+    resp_maint(:,ibare_sechiba) = zero
+    resp_growth(:,:)= resp_growth_d(:,:)*veget_cov_max(:,:)*dt_sechiba/one_day
+    co2_to_bm_radia(:,:)=co2_to_bm_dgvm(:,:)*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_to_bm is not included here as it is already encounted in the gpp
+    co2_flux(:,:) = resp_hetero(:,:) + resp_maint(:,:) + resp_growth(:,:) &
+         & + co2_fire(:,:)*veget_cov_max(:,:)*dt_sechiba/one_day &
+         & - gpp(:,:)
+    
+    temp_growth(:)=t2m_month(:)-tp_00 
+   
+  !! 7. Analytical spinup
+
+    IF (spinup_analytic) THEN
+
+       !! 7.1. Update V and U at sechiba time step
+       DO m = 2,nvm
+          DO j = 1,kjpindex 
+             ! V <- A * V
+             MatrixV(j,m,:,:) = MATMUL(matrixA(j,m,:,:),MatrixV(j,m,:,:))
+             ! U <- A*U + B
+             VectorU(j,m,:) = MATMUL(matrixA(j,m,:,:),VectorU(j,m,:)) + vectorB(j,m,:)
+          ENDDO ! loop pixels
+       ENDDO ! loop PFTS
+
+
+       !! 7.2. What happened at the end of the year ?
+       IF (LastTsYear) THEN
+
+          !
+          ! 7.2.1 Increase the years counter every LastTsYear which is the last sechiba time step of each year
+          !
+          global_years = global_years + 1 
+
+
+          !
+          ! 7.2.3 Is global_years is a multiple of the period time ?
+          !
+
+          !
+          ! 3.2.1 When global_years is a multiple of the spinup_period, we calculate :
+          !       1) the mean nbp flux over the period. This value is restarted
+          !       2) we solve the matrix system by Gauss Jordan method
+          !       3) We test if a point is at equilibrium : if yes, we mark the point (ok_equilibrium array)
+          !       4) Then we reset the matrix 
+          !       5) We erase the carbon_stock calculated by ORCHIDEE by the one found by the method
+          IF( MOD(global_years, spinup_period) == 0 ) THEN
+             WRITE(numout,*) 'Spinup analytic : Calculate if system is in equlibrium. global_years=',global_years
+             ! The number total of days during the forcing period is given by :
+             !    spinup_period*365 (we consider only the noleap calendar)
+             nbp_flux(:) = nbp_accu(:) / ( spinup_period * 365.)
+             ! Reset the values
+             nbp_accu(:) = zero
+
+             carbon_stock(:,ibare_sechiba,:) = zero
+             ! Prepare the matrix for the resolution
+             ! Add a temporary matrix W which contains I-MatrixV
+             ! we should take the opposite of matrixV and add the identitiy : we solve (I-MatrixV)*C = VectorU
+             MatrixW(:,:,:,:) = moins_un * MatrixV(:,:,:,:)
+             DO jv = 1,nbpools
+                MatrixW(:,:,jv,jv) =  MatrixW(:,:,jv,jv) + un
+             ENDDO
+             carbon_stock(:,:,:) = VectorU(:,:,:)
+
+             !
+             !  Solve the linear system
+             !
+             DO m = 2,nvm
+                DO j = 1,kjpindex
+                   ! the solution will be stored in VectorU : so it should be restarted before
+                   ! loop over npts and nvm, so we solved npts*(nvm-1) (7,7) linear systems
+                   CALL gauss_jordan_method(nbpools,MatrixW(j,m,:,:),carbon_stock(j,m,:))
+                ENDDO ! loop pixels
+             ENDDO ! loop PFTS
+
+             ! Reset temporary matrixW
+             MatrixW(:,:,:,:) = zero 
+
+
+             previous_stock(:,:,:) = current_stock(:,:,:)
+             current_stock(:,:,:) = carbon_stock(:,:,:)  
+             ! The relative error is calculated over the passive carbon pool (sum over the pfts) over the pixel.
+             CALL error_L1_passive(kjpindex,nvm, nbpools, current_stock, previous_stock, veget_max, &
+                  &                eps_carbon, carbon_eq)   
+
+             !! ok_equilibrium is saved,
+             WHERE( carbon_eq(:) .AND. .NOT.(ok_equilibrium(:)) )
+                ok_equilibrium(:) = .TRUE.  
+             ENDWHERE
+
+             ! Reset matrixV for the pixel to the identity matrix and vectorU to zero
+             MatrixV(:,:,:,:) = zero
+             VectorU(:,:,:) = zero
+             DO jv = 1,nbpools
+                MatrixV(:,:,jv,jv) = un
+             END DO
+             IF (printlev >= 2) 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)
+             carbon(:,iactive,:) = carbon_stock(:,:,iactive_pool)
+             carbon(:,islow,:) = carbon_stock(:,:,islow_pool)
+             carbon(:,ipassive,:) = carbon_stock(:,:,ipassive_pool) 
+
+             ! 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 (printlev >=1) THEN
+                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
+             END IF
+          ENDIF ! ( MOD(global_years,spinup_period) == 0)
+       ENDIF ! (LastTsYear)
+
+    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, co2_to_bm_radia, assim_param) 
+    
+    IMPLICIT NONE
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! Indices of the terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: co2_to_bm_radia   !! virtual gpp flux between atmosphere and biosphere
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(in) :: assim_param  !! min+max+opt temperatures (K) & vmax for photosynthesis  
+
+    !! 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:nslm)                 :: 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)           :: 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)     :: soilcarbon_input_inst    !! Quantity of carbon going into carbon pools from 
+                                                                              !! litter decomposition 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+    
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+    REAL(r_std)                                   :: sf_time                  !! Intermediate variable to calculate current time 
+                                                                              !! step 
+    INTEGER(i_std)                                :: max_totsize              !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step            !! Memory management - memory required to store one 
+                                                                              !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp              !! Memory management - memory required to store one 
+                                                                              !! time step on all processors(Mb) 
+    REAL(r_std)                                   :: xn                       !! How many times have we treated in this forcing 
+    REAL(r_std), DIMENSION(kjpindex)              :: vartmp                   !! Temporary variable
+    INTEGER(i_std)                                :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh                   !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct                   !! ??
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                     !! ??
+    REAL(r_std),DIMENSION(nbp_glo)                :: clay_g                   !! Clay fraction of soil (0-1, unitless), parallel 
+                                                                              !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: soilcarbon_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(:,:,:)      :: control_moist_g          !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_temp_g           !! Temperature control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)        :: npp_equil_g              !! Equilibrium NPP written to forcesoil 
+                                                                              !! @tex $(gC m^{-2} year^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+
+    REAL(r_std)                                   :: net_cflux_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_cflux_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_sum !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_tot !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    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, days_since_beg, &
+         ind, adapted, regenerate, &
+         humrel_daily, gdd_init_date, litterhum_daily, &
+         t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+         soilhum_daily, precip_daily, &
+         gpp_daily, npp_daily, turnover_daily, &
+         humrel_month, humrel_week, &
+         t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+         tsoil_month, soilhum_month, fireindex, firelitter, &
+         maxhumrel_lastyear, maxhumrel_thisyear, &
+         minhumrel_lastyear, minhumrel_thisyear, &
+         maxgppweek_lastyear, maxgppweek_thisyear, &
+         gdd0_lastyear, gdd0_thisyear, &
+         precip_lastyear, precip_thisyear, &
+         gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+         PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+         maxfpc_lastyear, maxfpc_thisyear, &
+         turnover_longterm, gpp_week, biomass, resp_maint_part, &
+         leaf_age, leaf_frac, &
+         senescence, when_growthinit, age, &
+         resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, co2_to_bm_dgvm, co2_to_bm_radia, &
+         veget_lastlight, everywhere, need_adjacent, &
+         RIP_time, &
+         time_hum_min, hum_min_dormance, &
+         litterpart, litter, dead_leaves, &
+         carbon, lignin_struc,turnover_time,&
+         prod10,prod100,flux10, flux100, &
+         convflux, cflux_prod10, cflux_prod100, &
+         prod10_harvest,prod100_harvest,flux10_harvest, flux100_harvest, &
+         convflux_harvest, cflux_prod10_harvest, cflux_prod100_harvest, &
+         convfluxpft, fDeforestToProduct, fLulccResidue,fHarvestToProduct, &
+         woodharvestpft, bm_to_litter, carb_mass_total, &
+         Tseason, Tseason_length, Tseason_tmp, &
+         Tmin_spring_time, begin_leaves, onset_date, &
+         global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+         MatrixV, VectorU, previous_stock, current_stock, assim_param)
+    
+    !! 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 
+       IF (printlev >= 1) WRITE(numout,*) 'stomate: writing the forcing file for carbon spinup'
+       DO iatt = 1, nparan*nbyear
+          IF ( nforce(iatt) > 0 ) THEN
+             soilcarbon_input(:,:,:,iatt) = &
+                  & soilcarbon_input(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+             control_moist(:,:,iatt) = &
+                  & control_moist(:,:,iatt)/REAL(nforce(iatt),r_std)
+             control_temp(:,:,iatt) = &
+                  & control_temp(:,:,iatt)/REAL(nforce(iatt),r_std)
+             npp_equil(:,iatt) = &
+                  & npp_equil(:,iatt)/REAL(nforce(iatt),r_std)
+          ELSE
+             IF (printlev >= 1) THEN
+                WRITE(numout,*) 'We have no soil carbon forcing data for this time step:', iatt
+                WRITE(numout,*) ' -> we set them to zero'
+             END IF
+             soilcarbon_input(:,:,:,iatt) = zero
+             control_moist(:,:,iatt) = zero
+             control_temp(:,:,iatt) = zero
+             npp_equil(:,iatt) = zero
+          ENDIF
+       ENDDO
+       
+       ! Allocate memory for parallel computing
+       IF (is_root_prc) THEN
+          ALLOCATE(soilcarbon_input_g(nbp_glo,ncarb,nvm,nparan*nbyear))
+          ALLOCATE(control_moist_g(nbp_glo,nlevs,nparan*nbyear))
+          ALLOCATE(control_temp_g(nbp_glo,nlevs,nparan*nbyear))
+          ALLOCATE(npp_equil_g(nbp_glo,nparan*nbyear))
+       ENDIF
+       
+       ! Gather distributed variables
+       CALL gather(clay,clay_g)
+       CALL gather(soilcarbon_input,soilcarbon_input_g)
+       CALL gather(control_moist,control_moist_g)
+       CALL gather(control_temp,control_temp_g)
+       CALL gather(npp_equil,npp_equil_g)
+       
+       !! 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
+          IF (printlev>=2) 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,'soilcarbon_input',r_typ, &
+               &                        (/ d_id(1),d_id(2),d_id(3),d_id(5) /),vid)
+          ier = NF90_DEF_VAR (Cforcing_id,'control_moist',r_typ, &
+               &                        (/ d_id(1),d_id(4),d_id(5) /),vid)
+          ier = NF90_DEF_VAR (Cforcing_id,'control_temp',r_typ, &
+               &                        (/ d_id(1),d_id(4),d_id(5) /),vid)
+          ier = NF90_DEF_VAR (Cforcing_id,'npp_equil',r_typ, &
+               &                        (/ d_id(1),d_id(5) /),vid)
+          ier = NF90_ENDDEF (Cforcing_id)
+          
+          ! Given the name of a varaible, nf90_inq_varid finds the variable 
+          ! ID (::vid). Put data value(s) into variable ::vid 
+          ier = NF90_INQ_VARID (Cforcing_id,'points',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, &
+               &                          (/(REAL(i,r_std),i=1,nbp_glo)/))
+          ier = NF90_INQ_VARID (Cforcing_id,'carbtype',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, &
+               &                        (/(REAL(i,r_std),i=1,ncarb)/))
+          ier = NF90_INQ_VARID (Cforcing_id,'vegtype',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, &
+               &                            (/(REAL(i,r_std),i=1,nvm)/))
+          ier = NF90_INQ_VARID (Cforcing_id,'level',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, &
+               &                          (/(REAL(i,r_std),i=1,nlevs)/))
+          ier = NF90_INQ_VARID (Cforcing_id,'time_step',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, &
+               &                          (/(REAL(i,r_std),i=1,nparan*nbyear)/))
+          ier = NF90_INQ_VARID (Cforcing_id,'index',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, REAL(index_g,r_std) )
+          ier = NF90_INQ_VARID (Cforcing_id,'clay',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, clay_g )
+          ier = NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, soilcarbon_input_g )
+          ier = NF90_INQ_VARID (Cforcing_id,'control_moist',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, control_moist_g )
+          ier = NF90_INQ_VARID (Cforcing_id,'control_temp',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, control_temp_g )
+          ier = NF90_INQ_VARID (Cforcing_id,'npp_equil',vid)
+          ier = NF90_PUT_VAR (Cforcing_id,vid, npp_equil_g )
+          
+          ! Close netCDF
+          ier = NF90_CLOSE (Cforcing_id)
+          IF (ier /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'stomate_finalize', &
+                  &        'PROBLEM in closing Cforcing file', &
+                  &        NF90_STRERROR(ier),'')
+          END IF
+          
+          Cforcing_id = -1
+       ENDIF
+
+       ! Clear memory
+       IF (is_root_prc) THEN
+          DEALLOCATE(soilcarbon_input_g)
+          DEALLOCATE(control_moist_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
+!_ ================================================================================================================================
+    
+  !! 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 )
+       IF ( printlev >=3 ) THEN
+          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)
+       END IF
+    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
+    
+    IF (printlev >=2) THEN
+       WRITE(numout,*) 'stomate first call - overview of the activated flags:'
+       WRITE(numout,*) '  STOMATE: ', ok_stomate
+       WRITE(numout,*) '  LPJ: ', ok_dgvm
+    END IF
+  !! 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(ind(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ind. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(adapted(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for adapted. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(regenerate(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for regenerate. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litterhum_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litterhum_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_min_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_min_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsurf_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsurf_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsoil_daily(kjpindex,nslm),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*nslm words',kjpindex,nslm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soilhum_daily(kjpindex,nslm),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*nslm words',kjpindex,nslm
+       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
+!!xchen
+    ALLOCATE(VPD_daily(kjpindex),stat=ier)                                   
+    l_error = l_error .OR. (ier /= 0)                                           
+    IF (l_error) THEN                                                           
+       WRITE(numout,*) 'Memory allocation error for VPD_daily. We stop. We need kjpindex words',kjpindex,nvm
+       STOP 'stomate_init'                                                      
+    ENDIF
+    ALLOCATE(VPD_week(kjpindex),stat=ier)                                      
+    l_error = l_error .OR. (ier /= 0)                                           
+    IF (l_error) THEN                                                           
+       WRITE(numout,*) 'Memory allocation error for VPD_week. We stop. We need kjpindex words',kjpindex,nvm
+       STOP 'stomate_init'                                                      
+    ENDIF 
+    ALLOCATE(swdown_daily(kjpindex),stat=ier)                                   
+    l_error = l_error .OR. (ier /= 0)                                           
+    IF (l_error) THEN                                                           
+       WRITE(numout,*) 'Memory allocation error for swdown_daily. We stop. We need kjpindex words',kjpindex,nvm
+       STOP 'stomate_init'                                                      
+    ENDIF   
+    ALLOCATE(swdown_week(kjpindex),stat=ier)                                    
+    l_error = l_error .OR. (ier /= 0)                                           
+    IF (l_error) THEN                                                           
+       WRITE(numout,*) 'Memory allocation error for swdown_week. We stop. We need kjpindex words',kjpindex,nvm
+       STOP 'stomate_init'                                                      
+    ENDIF  
+!! liuly xchen above
+!! liulye below
+    ALLOCATE(precip_week(kjpindex),stat=ier)                                    
+    l_error = l_error .OR. (ier /= 0)                                           
+    IF (l_error) THEN                                                           
+       WRITE(numout,*) 'Memory allocation error for precip_week. We stop. We need kjpindex words',kjpindex,nvm
+       STOP 'stomate_init'                                                      
+    ENDIF  
+
+
+
+    ALLOCATE(gpp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gpp_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(npp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for npp_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_daily(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_daily. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &   kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_littercalc(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_littercalc. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+        &  kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_month(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_month. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_week. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_longterm(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_longterm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_month(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_month. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason_length(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason_length. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason_tmp(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason_tmp. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tmin_spring_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tmin_spring_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(onset_date(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for onset_date. We stop. We need kjpindex*nvm*nparts words',kjpindex,nvm,2
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_week(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_week. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsoil_month(kjpindex,nslm),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*nslm words',kjpindex,nslm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soilhum_month(kjpindex,nslm),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*nslm words',kjpindex,nslm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(fireindex(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fireindex. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(firelitter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for firelitter. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxhumrel_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxhumrel_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(minhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for minhumrel_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(minhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for minhumrel_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxgppweek_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxgppweek_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxgppweek_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxgppweek_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd0_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd0_lastyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd0_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd0_thisyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_init_date(kjpindex,2),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_init_date. We stop. We need kjpindex*2 words',kjpindex,2
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_from_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_from_growthinit. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_lastyear. We stop. We need kjpindex*nvm words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_thisyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_m5_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_m5_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_midwinter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_midwinter. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ncd_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ncd_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ngd_minus5(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ngd_minus5. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(PFTpresent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for PFTpresent. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(npp_longterm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for npp_longterm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lm_lastyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lm_lastyearmax. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lm_thisyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lm_thisyearmax. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxfpc_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxfpc_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxfpc_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxfpc_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_longterm(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_longterm. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gpp_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gpp_week. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(biomass(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for biomass. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(senescence(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for senescence. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(begin_leaves(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for begin_leaves. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(when_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for when_growthinit. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(age(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for age. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_hetero_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_hetero_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_hetero_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_hetero_radia. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_growth_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_growth_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_fire(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_fire. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_to_bm_dgvm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_to_bm_dgvm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(veget_lastlight(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_lastlight. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(everywhere(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for everywhere. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(need_adjacent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for need_adjacent. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(leaf_age(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for leaf_age. We stop. We need kjpindex*nvm*nleafages words', & 
+       &      kjpindex,nvm,nleafages
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(leaf_frac(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for leaf_frac. We stop. We need kjpindex*nvm*nleafages words', & 
+       &      kjpindex,nvm,nleafages
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(RIP_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for RIP_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(time_hum_min(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for time_hum_min. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(hum_min_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for hum_min_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litterpart(kjpindex,nvm,nlitt),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litterpart. We stop. We need kjpindex*nvm*nlitt words',  &
+       &  kjpindex,nvm,nlitt
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litter(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(carbon(kjpindex,ncarb,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carbon. We stop. We need kjpindex*ncarb*nvm words',kjpindex,ncarb,nvm
+       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(turnover_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nep_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nep_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nep_monthly(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nep_monthly. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod_monthly(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod_monthly. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+ 
+    ALLOCATE (harvest_above_monthly(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for harvest_above_monthly. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(bm_to_litter(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for bm_to_litter. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(bm_to_littercalc(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for bm_to_littercalc. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &   kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(herbivores(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for herbivores. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(hori_index(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for hori_index. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(horipft_index(kjpindex*nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horipft_index. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_part_radia(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_part_radia. We stop. We need kjpindex*nvm*nparts words', &
+       &  kjpindex,nvm,nparts
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_radia. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_part(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_part. We stop. We need kjpindex*nvm*nparts words', &
+       &    kjpindex,nvm,nparts
+       STOP 'stomate_init'
+    ENDIF
+    resp_maint_part(:,:,:) = zero
+
+    ALLOCATE (horip10_index(kjpindex*10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip10_index. We stop. We need kjpindex*10 words',kjpindex,10
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip100_index(kjpindex*100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip100_index. We stop. We need kjpindex*100 words',kjpindex,100
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip11_index(kjpindex*11), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip11_index. We stop. We need kjpindex*11 words',kjpindex,11
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip101_index(kjpindex*101), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip101_index. We stop. We need kjpindex*101 words',kjpindex,101
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (prod10(kjpindex,0:10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod10. We stop. We need kjpindex*11 words',kjpindex,11
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (prod100(kjpindex,0:100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod100. We stop. We need kjpindex*101 words',kjpindex,101
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (flux10(kjpindex,10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux10. We stop. We need kjpindex*10 words',kjpindex,10
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (flux100(kjpindex,100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux100. We stop. We need kjpindex*100 words',kjpindex,100
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (convflux(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for convflux. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod10(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod10. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod100(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod100. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (prod10_harvest(kjpindex,0:10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod10_harvest. We stop. We need kjpindex*11 words',kjpindex,11
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (prod100_harvest(kjpindex,0:100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod100_harvest. We stop. We need kjpindex*101 words',kjpindex,101
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (flux10_harvest(kjpindex,10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux10_harvest. We stop. We need kjpindex*10 words',kjpindex,10
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (flux100_harvest(kjpindex,100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux100_harvest. We stop. We need kjpindex*100 words',kjpindex,100
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (convflux_harvest(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for convflux_harvest. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod10_harvest(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod10_harvest. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod100_harvest(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod100_harvest. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (woodharvestpft(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for woodharvestpft. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (convfluxpft(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for convfluxpft. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (fDeforestToProduct(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fDeforestToProduct. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (fLulccResidue(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fLulccResidue. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (fHarvestToProduct(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fHarvestToProduct. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (harvest_above(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for harvest_above. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (carb_mass_total(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carb_mass_total. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (soilcarbon_input_daily(kjpindex,ncarb,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilcarbon_input_daily. We stop. We need kjpindex*ncarb*nvm words', & 
+       &    kjpindex,ncarb,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_temp_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(ok_equilibrium(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ok_equilibrium. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(carbon_eq(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carbon_eq. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_accu(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_accu. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_flux(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_flux. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(matrixA(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for matrixA. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(vectorB(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for vectorB. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(VectorU(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for VectorU. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(MatrixV(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for MatrixV. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(MatrixW(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for MatrixW. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(previous_stock(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for previous_stock. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(current_stock(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for current_stock. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+    
+  !! 5. File definitions
+
+    ! Store history and restart files in common variables
+    hist_id_stomate = hist_id_stom
+    hist_id_stomate_IPCC = hist_id_stom_IPCC
+    rest_id_stomate = rest_id_stom
+    
+    ! In STOMATE reduced grids are used containing only terrestrial pixels.
+    ! Build a new indexing table for the vegetation fields separating 
+    ! between the different PFTs. Note that ::index has dimension (kjpindex) 
+    ! wheras ::indexpft has dimension (kjpindex*nvm). 
+
+    hori_index(:) = index(:)
+
+    DO j = 1, nvm
+       DO ji = 1, kjpindex
+          horipft_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    ! Similar index tables are build for the land cover change variables
+    DO j = 1, 10
+       DO ji = 1, kjpindex
+          horip10_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 100
+       DO ji = 1, kjpindex
+          horip100_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 11
+       DO ji = 1, kjpindex
+          horip11_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 101
+       DO ji = 1, kjpindex
+          horip101_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+  !! 6. Initialization of global and land cover change variables. 
+
+    ! All variables are cumulative variables. bm_to_litter is not and is therefore
+    ! excluded
+    !   bm_to_litter(:,:,:) = zero
+    turnover_daily(:,:,:,:) = zero
+    resp_hetero_d(:,:) = zero
+    nep_daily(:,:) = zero
+    nep_monthly(:,:) = zero
+    cflux_prod_monthly(:) = zero
+    harvest_above_monthly(:) = zero
+    control_moist_daily(:,:) = zero
+    control_temp_daily(:,:) = zero
+    soilcarbon_input_daily(:,:,:) = zero
+    ! Land cover change variables
+    prod10(:,:)  = zero
+    prod100(:,:) = zero
+    flux10(:,:)  = zero
+    flux100(:,:) = zero
+    convflux(:)  = zero
+    cflux_prod10(:) = zero
+    cflux_prod100(:) = zero
+    prod10_harvest(:,:)  = zero
+    prod100_harvest(:,:) = zero
+    flux10_harvest(:,:)  = zero
+    flux100_harvest(:,:) = zero
+    convflux_harvest(:)  = zero
+    cflux_prod10_harvest(:) = zero
+    cflux_prod100_harvest(:) = zero
+    woodharvestpft(:,:) = zero
+    fpc_max(:,:)=zero
+    
+    convfluxpft(:,:)=zero
+    fDeforestToProduct(:,:)=zero
+    fLulccResidue(:,:)=zero
+    fHarvestToProduct(:,:)=zero
+  END SUBROUTINE stomate_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_clear
+!!
+!>\BRIEF        Deallocate memory of the stomate variables.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_clear
+
+  !! 1. Deallocate all dynamics variables
+
+    IF (ALLOCATED(veget_cov_max)) DEALLOCATE(veget_cov_max)
+    IF (ALLOCATED(ind)) DEALLOCATE(ind)
+    IF (ALLOCATED(adapted)) DEALLOCATE(adapted)
+    IF (ALLOCATED(regenerate)) DEALLOCATE(regenerate)
+    IF (ALLOCATED(humrel_daily)) DEALLOCATE(humrel_daily)
+    IF (ALLOCATED(gdd_init_date)) DEALLOCATE(gdd_init_date)
+    IF (ALLOCATED(litterhum_daily)) DEALLOCATE(litterhum_daily)
+    IF (ALLOCATED(t2m_daily))  DEALLOCATE(t2m_daily)
+    IF (ALLOCATED(t2m_min_daily))  DEALLOCATE(t2m_min_daily)
+    IF (ALLOCATED(tsurf_daily))  DEALLOCATE(tsurf_daily)
+    IF (ALLOCATED(tsoil_daily)) DEALLOCATE(tsoil_daily)
+    IF (ALLOCATED(soilhum_daily)) DEALLOCATE(soilhum_daily)
+    IF (ALLOCATED(precip_daily)) DEALLOCATE(precip_daily)
+    IF (ALLOCATED(gpp_daily)) DEALLOCATE(gpp_daily)
+    IF (ALLOCATED(npp_daily)) DEALLOCATE(npp_daily)
+!!@xchen
+    IF (ALLOCATED(VPD_daily)) DEALLOCATE(VPD_daily)                             
+    IF (ALLOCATED(VPD_week)) DEALLOCATE(VPD_week)                           
+    IF (ALLOCATED(swdown_daily)) DEALLOCATE(swdown_daily)                        
+    IF (ALLOCATED(swdown_week)) DEALLOCATE(swdown_week)  
+!! liuly xchen above
+!! liulye 
+    IF (ALLOCATED(precip_week)) DEALLOCATE(precip_week)  
+
+
+    IF (ALLOCATED(turnover_daily)) DEALLOCATE(turnover_daily)
+    IF (ALLOCATED(turnover_littercalc)) DEALLOCATE(turnover_littercalc)
+    IF (ALLOCATED(humrel_month)) DEALLOCATE(humrel_month)
+    IF (ALLOCATED(humrel_week)) DEALLOCATE(humrel_week)
+    IF (ALLOCATED(t2m_longterm)) DEALLOCATE(t2m_longterm)
+    IF (ALLOCATED(t2m_month)) DEALLOCATE(t2m_month)
+    IF (ALLOCATED(Tseason)) DEALLOCATE(Tseason)
+    IF (ALLOCATED(Tseason_length)) DEALLOCATE(Tseason_length)
+    IF (ALLOCATED(Tseason_tmp)) DEALLOCATE(Tseason_tmp)
+    IF (ALLOCATED(Tmin_spring_time)) DEALLOCATE(Tmin_spring_time)
+    IF (ALLOCATED(onset_date)) DEALLOCATE(onset_date)
+    IF (ALLOCATED(begin_leaves)) DEALLOCATE(begin_leaves)
+    IF (ALLOCATED(t2m_week)) DEALLOCATE(t2m_week)
+    IF (ALLOCATED(tsoil_month)) DEALLOCATE(tsoil_month)
+    IF (ALLOCATED(soilhum_month)) DEALLOCATE(soilhum_month)
+    IF (ALLOCATED(fireindex)) DEALLOCATE(fireindex)
+    IF (ALLOCATED(firelitter)) DEALLOCATE(firelitter)
+    IF (ALLOCATED(maxhumrel_lastyear)) DEALLOCATE(maxhumrel_lastyear)
+    IF (ALLOCATED(maxhumrel_thisyear)) DEALLOCATE(maxhumrel_thisyear)
+    IF (ALLOCATED(minhumrel_lastyear)) DEALLOCATE(minhumrel_lastyear)
+    IF (ALLOCATED(minhumrel_thisyear)) DEALLOCATE(minhumrel_thisyear)
+    IF (ALLOCATED(maxgppweek_lastyear)) DEALLOCATE(maxgppweek_lastyear)
+    IF (ALLOCATED(maxgppweek_thisyear)) DEALLOCATE(maxgppweek_thisyear)
+    IF (ALLOCATED(gdd0_lastyear)) DEALLOCATE(gdd0_lastyear)
+    IF (ALLOCATED(gdd0_thisyear)) DEALLOCATE(gdd0_thisyear)
+    IF (ALLOCATED(precip_lastyear)) DEALLOCATE(precip_lastyear)
+    IF (ALLOCATED(precip_thisyear)) DEALLOCATE(precip_thisyear)
+    IF (ALLOCATED(gdd_m5_dormance)) DEALLOCATE(gdd_m5_dormance)
+    IF (ALLOCATED(gdd_from_growthinit)) DEALLOCATE(gdd_from_growthinit)
+    IF (ALLOCATED(gdd_midwinter)) DEALLOCATE(gdd_midwinter)
+    IF (ALLOCATED(ncd_dormance)) DEALLOCATE(ncd_dormance)
+    IF (ALLOCATED(ngd_minus5))  DEALLOCATE(ngd_minus5)
+    IF (ALLOCATED(PFTpresent)) DEALLOCATE(PFTpresent)
+    IF (ALLOCATED(npp_longterm)) DEALLOCATE(npp_longterm)
+    IF (ALLOCATED(lm_lastyearmax)) DEALLOCATE(lm_lastyearmax)
+    IF (ALLOCATED(lm_thisyearmax)) DEALLOCATE(lm_thisyearmax)
+    IF (ALLOCATED(maxfpc_lastyear)) DEALLOCATE(maxfpc_lastyear)
+    IF (ALLOCATED(maxfpc_thisyear)) DEALLOCATE(maxfpc_thisyear)
+    IF (ALLOCATED(turnover_longterm)) DEALLOCATE(turnover_longterm)
+    IF (ALLOCATED(gpp_week)) DEALLOCATE(gpp_week)
+    IF (ALLOCATED(biomass)) DEALLOCATE(biomass)
+    IF (ALLOCATED(senescence)) DEALLOCATE(senescence)
+    IF (ALLOCATED(when_growthinit)) DEALLOCATE(when_growthinit)
+    IF (ALLOCATED(age))  DEALLOCATE(age)
+    IF (ALLOCATED(resp_hetero_d)) DEALLOCATE(resp_hetero_d)
+    IF (ALLOCATED(resp_hetero_radia)) DEALLOCATE(resp_hetero_radia)
+    IF (ALLOCATED(resp_maint_d)) DEALLOCATE(resp_maint_d)
+    IF (ALLOCATED(resp_growth_d)) DEALLOCATE(resp_growth_d)
+    IF (ALLOCATED(co2_fire)) DEALLOCATE(co2_fire)
+    IF (ALLOCATED(co2_to_bm_dgvm)) DEALLOCATE(co2_to_bm_dgvm)
+    IF (ALLOCATED(veget_lastlight)) DEALLOCATE(veget_lastlight)
+    IF (ALLOCATED(everywhere)) DEALLOCATE(everywhere)
+    IF (ALLOCATED(need_adjacent)) DEALLOCATE(need_adjacent)
+    IF (ALLOCATED(leaf_age)) DEALLOCATE(leaf_age)
+    IF (ALLOCATED(leaf_frac)) DEALLOCATE(leaf_frac)
+    IF (ALLOCATED(RIP_time)) DEALLOCATE(RIP_time)
+    IF (ALLOCATED(time_hum_min)) DEALLOCATE(time_hum_min)
+    IF (ALLOCATED(hum_min_dormance)) DEALLOCATE(hum_min_dormance)
+    IF (ALLOCATED(litterpart)) DEALLOCATE(litterpart)
+    IF (ALLOCATED(litter)) DEALLOCATE(litter)
+    IF (ALLOCATED(dead_leaves)) DEALLOCATE(dead_leaves)
+    IF (ALLOCATED(carbon)) DEALLOCATE(carbon)
+    IF (ALLOCATED(lignin_struc)) DEALLOCATE(lignin_struc)
+    IF (ALLOCATED(turnover_time)) DEALLOCATE(turnover_time)
+    IF (ALLOCATED(nep_daily)) DEALLOCATE(nep_daily)
+    IF (ALLOCATED(nep_monthly)) DEALLOCATE(nep_monthly)
+    IF (ALLOCATED(harvest_above_monthly)) DEALLOCATE (harvest_above_monthly)
+    IF (ALLOCATED(cflux_prod_monthly)) DEALLOCATE (cflux_prod_monthly)
+    IF (ALLOCATED(bm_to_litter)) DEALLOCATE(bm_to_litter)
+    IF (ALLOCATED(bm_to_littercalc)) DEALLOCATE(bm_to_littercalc)
+    IF (ALLOCATED(herbivores)) DEALLOCATE(herbivores)
+    IF (ALLOCATED(resp_maint_part_radia)) DEALLOCATE(resp_maint_part_radia)
+    IF (ALLOCATED(resp_maint_radia)) DEALLOCATE(resp_maint_radia)
+    IF (ALLOCATED(resp_maint_part)) DEALLOCATE(resp_maint_part)
+    IF (ALLOCATED(hori_index)) DEALLOCATE(hori_index)
+    IF (ALLOCATED(horipft_index)) DEALLOCATE(horipft_index)
+    IF (ALLOCATED(clay_fm)) DEALLOCATE(clay_fm)
+    IF (ALLOCATED(humrel_daily_fm)) DEALLOCATE(humrel_daily_fm)
+    IF (ALLOCATED(litterhum_daily_fm))  DEALLOCATE(litterhum_daily_fm)
+    IF (ALLOCATED(t2m_daily_fm))  DEALLOCATE(t2m_daily_fm)
+    IF (ALLOCATED(t2m_min_daily_fm))  DEALLOCATE(t2m_min_daily_fm)
+    IF (ALLOCATED(tsurf_daily_fm)) DEALLOCATE(tsurf_daily_fm)
+    IF (ALLOCATED(tsoil_daily_fm)) DEALLOCATE(tsoil_daily_fm)
+    IF (ALLOCATED(soilhum_daily_fm))  DEALLOCATE(soilhum_daily_fm)
+    IF (ALLOCATED(precip_fm)) DEALLOCATE(precip_fm)
+    IF (ALLOCATED(gpp_daily_fm))  DEALLOCATE(gpp_daily_fm)
+    IF (ALLOCATED(veget_fm)) DEALLOCATE(veget_fm)
+    IF (ALLOCATED(veget_max_fm)) DEALLOCATE(veget_max_fm)
+    IF (ALLOCATED(lai_fm))  DEALLOCATE(lai_fm)
+    !! liulyc liulyw link to xuhui's crop
+    IF (ALLOCATED(swdown_fm))  DEALLOCATE(swdown_fm)
+    !
+    IF (ALLOCATED(ok_equilibrium)) DEALLOCATE(ok_equilibrium)
+    IF (ALLOCATED(carbon_eq)) DEALLOCATE(carbon_eq)
+    IF (ALLOCATED(matrixA)) DEALLOCATE(matrixA)
+    IF (ALLOCATED(vectorB)) DEALLOCATE(vectorB)
+    IF (ALLOCATED(MatrixV)) DEALLOCATE(MatrixV)
+    IF (ALLOCATED(VectorU)) DEALLOCATE(VectorU)
+    IF (ALLOCATED(MatrixW)) DEALLOCATE(MatrixW)
+    IF (ALLOCATED(previous_stock)) DEALLOCATE(previous_stock)
+    IF (ALLOCATED(current_stock)) DEALLOCATE(current_stock) 
+    IF (ALLOCATED(nbp_accu)) DEALLOCATE(nbp_accu)
+    IF (ALLOCATED(nbp_flux)) DEALLOCATE(nbp_flux)
+
+    IF (ALLOCATED(clay_fm_g)) DEALLOCATE(clay_fm_g)
+    IF (ALLOCATED(humrel_daily_fm_g)) DEALLOCATE(humrel_daily_fm_g)
+    IF (ALLOCATED(litterhum_daily_fm_g))  DEALLOCATE(litterhum_daily_fm_g)
+    IF (ALLOCATED(t2m_daily_fm_g))  DEALLOCATE(t2m_daily_fm_g)
+    IF (ALLOCATED(t2m_min_daily_fm_g))  DEALLOCATE(t2m_min_daily_fm_g)
+    IF (ALLOCATED(tsurf_daily_fm_g)) DEALLOCATE(tsurf_daily_fm_g)
+    IF (ALLOCATED(tsoil_daily_fm_g)) DEALLOCATE(tsoil_daily_fm_g)
+    IF (ALLOCATED(soilhum_daily_fm_g))  DEALLOCATE(soilhum_daily_fm_g)
+    IF (ALLOCATED(precip_fm_g)) DEALLOCATE(precip_fm_g)
+    IF (ALLOCATED(gpp_daily_fm_g))  DEALLOCATE(gpp_daily_fm_g)
+    IF (ALLOCATED(veget_fm_g)) DEALLOCATE(veget_fm_g)
+    IF (ALLOCATED(veget_max_fm_g)) DEALLOCATE(veget_max_fm_g)
+    IF (ALLOCATED(lai_fm_g))  DEALLOCATE(lai_fm_g)
+    !! liulyc liulyw link to xuhui's crop but this line lack of IF compare with xchen's code
+    IF (ALLOCATED(swdown_fm_g))  DEALLOCATE(swdown_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(soilcarbon_input)) DEALLOCATE(soilcarbon_input)
+    IF ( ALLOCATED (horip10_index)) DEALLOCATE (horip10_index)
+    IF ( ALLOCATED (horip100_index)) DEALLOCATE (horip100_index)
+    IF ( ALLOCATED (horip11_index)) DEALLOCATE (horip11_index)
+    IF ( ALLOCATED (horip101_index)) DEALLOCATE (horip101_index)
+    IF ( ALLOCATED (prod10)) DEALLOCATE (prod10)
+    IF ( ALLOCATED (prod100)) DEALLOCATE (prod100)
+    IF ( ALLOCATED (flux10)) DEALLOCATE (flux10)
+    IF ( ALLOCATED (flux100)) DEALLOCATE (flux100)
+    IF ( ALLOCATED (convflux)) DEALLOCATE (convflux)
+    IF ( ALLOCATED (cflux_prod10)) DEALLOCATE (cflux_prod10)
+    IF ( ALLOCATED (cflux_prod100)) DEALLOCATE (cflux_prod100)
+    IF ( ALLOCATED (prod10_harvest)) DEALLOCATE (prod10_harvest)
+    IF ( ALLOCATED (prod100_harvest)) DEALLOCATE (prod100_harvest)
+    IF ( ALLOCATED (flux10_harvest)) DEALLOCATE (flux10_harvest)
+    IF ( ALLOCATED (flux100_harvest)) DEALLOCATE (flux100_harvest)
+    IF ( ALLOCATED (convflux_harvest)) DEALLOCATE (convflux_harvest)
+    IF ( ALLOCATED (cflux_prod10_harvest)) DEALLOCATE (cflux_prod10_harvest)
+    IF ( ALLOCATED (cflux_prod100_harvest)) DEALLOCATE (cflux_prod100_harvest)
+    IF ( ALLOCATED (woodharvestpft)) DEALLOCATE (woodharvestpft)
+    IF ( ALLOCATED (convfluxpft)) DEALLOCATE (convfluxpft)
+    IF ( ALLOCATED (fDeforestToProduct)) DEALLOCATE (fDeforestToProduct)
+    IF ( ALLOCATED (fLulccResidue)) DEALLOCATE (fLulccResidue)
+    IF ( ALLOCATED (fHarvestToProduct)) DEALLOCATE (fHarvestToProduct)
+    IF ( ALLOCATED (harvest_above)) DEALLOCATE (harvest_above)
+    IF ( ALLOCATED (soilcarbon_input_daily)) DEALLOCATE (soilcarbon_input_daily)
+    IF ( ALLOCATED (control_temp_daily)) DEALLOCATE (control_temp_daily)
+    IF ( ALLOCATED (control_moist_daily)) DEALLOCATE (control_moist_daily)
+
+    IF ( ALLOCATED (fpc_max)) DEALLOCATE (fpc_max)
+
+ !! 2. reset l_first
+
+    l_first_stomate=.TRUE.
+
+ !! 3. call to clear functions
+
+    CALL season_clear
+    CALL stomatelpj_clear
+    CALL littercalc_clear
+    CALL vmax_clear
+ 
+  END SUBROUTINE stomate_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_var_init
+!!
+!>\BRIEF        Initialize variables of stomate with a none-zero initial value.
+!! Subroutine is called only if ::ok_stomate = .TRUE. STOMATE diagnoses some 
+!! variables for SECHIBA : assim_param, deadleaf_cover, etc. These variables can 
+!! be recalculated from STOMATE's prognostic variables. Note that height is
+!! saved in SECHIBA.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): leaf age (::leaf_age) and fraction of leaves in leaf 
+!! age class (::leaf_frac). The maximum water on vegetation available for 
+!! interception, fraction of soil covered by dead leaves
+!! (::deadleaf_cover) and assimilation parameters (:: assim_param).
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_var_init &
+       &  (kjpindex, veget_cov_max, leaf_age, leaf_frac, &
+       &   dead_leaves, &
+       &   veget, lai, deadleaf_cover, assim_param)
+
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                             :: kjpindex        !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: veget           !! Fraction of pixel covered by PFT. Fraction 
+                                                                             !! accounts for none-biological land covers 
+                                                                             !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: veget_cov_max   !! Fractional coverage: maximum share of the pixel 
+                                                                             !! covered by a PFT (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nlitt),INTENT(in)  :: dead_leaves     !! Metabolic and structural fraction of dead leaves 
+                                                                             !! per ground area 
+                                                                             !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: lai             !! Leaf area index 
+                                                                             !! @tex $(m^2 m{-2})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(in) :: leaf_age     !! Age of different leaf classes per PFT (days)
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(in) :: leaf_frac    !! Fraction of leaves in leaf age class per PFT 
+                                                                             !! (unitless; 1)     
+
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(inout) :: assim_param   !! min+max+opt temperatures (K) & vmax for 
+                                                                             !! photosynthesis  
+    
+    !! 0.3 Output variables
+
+    REAL(r_std),DIMENSION(kjpindex), INTENT (out)         :: deadleaf_cover  !! Fraction of soil covered by dead leaves 
+                                                                             !! (unitless) 
+
+
+    ! 0.4 Local variables
+   
+    REAL(r_std),PARAMETER                                 :: dt_0 = zero     !! Dummy time step, must be zero
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: vcmax           !! Dummy vcmax 
+                                                                             !! @tex $(\mu mol m^{-2} s^{-1})$ @endtex
+!! liuly
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: vcmax_cl1           !! Dummy vcmax 
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: vcmax_cl2           !! Dummy vcmax 
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: vcmax_cl3           !! Dummy vcmax 
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: vcmax_cl4           !! Dummy vcmax
+    REAL(r_std),DIMENSION(kjpindex)                       :: ave_VPD              !! Vapor Pressure Deficit (kPa) 
+
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages)         :: leaf_age_tmp    !! Temporary variable
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages)         :: leaf_frac_tmp   !! Temporary variable
+                                                                             !! (unitless; 1)     
+    INTEGER(i_std)                                        :: j               !! Index (untiless)
+    
+!_ ================================================================================================================================   
+
+
+    ! Calculate assim_param if it was not found in the restart file
+    IF (ALL(assim_param(:,:,:)==val_exp)) THEN
+       ! Use temporary leaf_age_tmp and leaf_frac_tmp to preserve the input variables from being modified by the subroutine vmax.
+       leaf_age_tmp(:,:,:)=leaf_age(:,:,:)
+       leaf_frac_tmp(:,:,:)=leaf_frac(:,:,:)
+
+       !! 1.1 Calculate a temporary vcmax (stomate_vmax.f90)
+       CALL vmax (kjpindex, dt_0, leaf_age_tmp, leaf_frac_tmp, vcmax, vcmax_cl1,vcmax_cl2,vcmax_cl3,vcmax_cl4, VPD_week, ave_VPD) !!xchen liulyq removed N_limfert?
+
+       !! 1.2 transform into nvm vegetation types
+       assim_param(:,:,ivcmax) = zero
+       DO j = 2, nvm
+          assim_param(:,j,ivcmax)=vcmax(:,j)
+       ENDDO
+    END IF
+    
+    !! 2. Dead leaf cover (stomate_litter.f90)
+    CALL deadleaf (kjpindex, veget_cov_max, dead_leaves, deadleaf_cover)     
+    
+  END SUBROUTINE stomate_var_init
+
+
+!! ================================================================================================================================
+!! 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 	: 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 ::nslm 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(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,nslm,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,nslm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(soilhum_daily_fm(kjpindex,nslm,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,nslm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(precip_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables precip_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(gpp_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables gpp_daily_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(veget_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(veget_max_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_max_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(lai_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables lai_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(isf(nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables isf ',nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(nf_written(nsft_loc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables nf_written ',nsft_loc
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(nf_cumul(nsft_loc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables nf_cumul ',nsft_loc
+       STOP 'init_forcing'
+    ENDIF
+    !! liulyc liulyw link to xuhui's crop
+    ALLOCATE(swdown_fm(kjpindex,nsfm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'forcing_zero', 'Problem with memory allocation: forcing variable', 'swdown_fm', '')
+    
+  !! 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(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,nslm,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,nslm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(soilhum_daily_fm_g(nbp_glo,nslm,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,nslm,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
+
+       !! liulyc liulyw link xuhui's crop
+       ALLOCATE(swdown_fm_g(nbp_glo,nsfm),stat=ier)
+       IF (ier /= 0) CALL ipslerr(3, 'Problem with memory allocation: forcing variables,','swdown_fm_g', '', '')
+
+
+    ELSE
+       ! Allocate memory for co-processors
+       ALLOCATE(clay_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(humrel_daily_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(litterhum_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(t2m_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(t2m_min_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(tsurf_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(tsoil_daily_fm_g(0,nslm,nsfm),stat=ier)
+       ALLOCATE(soilhum_daily_fm_g(0,nslm,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)
+       !! liulyc liulyw link xuhui's crop
+       ALLOCATE(swdown_fm_g(0,nsfm),stat=ier)
+    ENDIF ! is_root_proc
+    
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables'
+       STOP 'init_forcing'
+    ENDIF
+
+  !! 3. Initilaize variables
+
+    CALL forcing_zero
+    
+  END SUBROUTINE init_forcing
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: forcing_zero
+!!
+!>\BRIEF        Initialize variables containing the forcing data; variables are 
+!! set to zero.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE forcing_zero
+    
+    clay_fm(:,:) = zero
+    humrel_daily_fm(:,:,:) = zero
+    litterhum_daily_fm(:,:) = zero
+    t2m_daily_fm(:,:) = zero
+    t2m_min_daily_fm(:,:) = zero
+    tsurf_daily_fm(:,:) = zero
+    tsoil_daily_fm(:,:,:) = zero
+    soilhum_daily_fm(:,:,:) = zero
+    precip_fm(:,:) = zero
+    gpp_daily_fm(:,:,:) = zero
+    veget_fm(:,:,:) = zero
+    veget_max_fm(:,:,:) = zero
+    lai_fm(:,:,:) = zero
+    !! liulyc liulyw link to xuhui's crop
+    swdown_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(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)
+    !! liulyc liulyw link to xuhui's crop
+    CALL gather(swdown_fm,swdown_fm_g)
+ 
+ !! 3. Append data to netCDF file
+   
+    IF (is_root_prc) THEN
+       ! The netCDF file has been created earlier in this module, a file ID is available 
+       ! and variables and dimensions have already been defined
+       DO iblocks = 1, nblocks
+          IF (ifirst(iblocks) /= ilast(iblocks)) THEN
+             ndim = 2
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(clay_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'clay',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  &              clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(humrel_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'humrel',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(litterhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'litterhum',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_min_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsurf_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsurf',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsoil_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsoil',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soilhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soilhum',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(precip_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'precip',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(gpp_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'gpp',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_max_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget_max',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(lai_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'lai',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+            !! liulyc liulyw link xuhui's crop
+            ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(swdown_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, &
+                  &            swdown_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+            !! liulyc liulyw above
+          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                        :: a_er=.FALSE.      !! Error catching from netcdf file
+!_ ================================================================================================================================
+
+    IF (printlev >= 4) WRITE(numout,*) "stomate_forcing_read "
+    
+  !! 1. Set to zero if the corresponding forcing state
+
+    ! has not yet been written into the file  
+    DO ii = 1, nsfm
+       IF (.NOT.nf_written(isf(ii))) THEN
+          clay_fm(:,ii) = zero
+          humrel_daily_fm(:,:,ii) = zero
+          litterhum_daily_fm(:,ii) = zero
+          t2m_daily_fm(:,ii) = zero
+          t2m_min_daily_fm(:,ii) = zero
+          tsurf_daily_fm(:,ii) = zero
+          tsoil_daily_fm(:,:,ii) = zero
+          soilhum_daily_fm(:,:,ii) = zero
+          precip_fm(:,ii) = zero
+          gpp_daily_fm(:,:,ii) = zero
+          veget_fm(:,:,ii) = zero
+          veget_max_fm(:,:,ii) = zero
+          lai_fm(:,:,ii) = zero
+         !! liulyc liulyw link to xuhui's crop
+          swdown_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 (printlev >= 4) 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 (printlev >= 4) 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 = 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)
+
+            !! liulyc liulyw link xuhui's crop
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(swdown_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'swdown',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &             swdown_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+            !! liulyc liulyw above
+
+             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(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)
+    !! liulyc liulyw link xuhui's crop
+    CALL scatter(swdown_fm_g,swdown_fm)
+  END SUBROUTINE stomate_forcing_read
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: setlai
+!!
+!>\BRIEF        Routine to force the lai in STOMATE. The code in this routine
+!! simply CALCULATES lai and is therefore not functional. The routine should be 
+!! rewritten if one wants to force lai.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE setlai(npts,lai)
+
+  !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                    :: npts !! Domain size - number of pixels (unitless)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: lai  !! PFT leaf area index @tex $(m^{2} m^{-2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: j    !! index (unitless)
+!_ ================================================================================================================================
+    
+    !! 1. Set lai for bare soil to zero
+
+    lai(:,ibare_sechiba) = zero
+
+    !! 2. Multiply foliage biomass by sla to calculate lai for all PFTs and pixels
+
+    DO j=2,nvm
+       lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+    ENDDO
+    
+  END SUBROUTINE setlai
+
+END MODULE stomate
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_alloc.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_alloc.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_alloc.f90	(revision 8430)
@@ -0,0 +1,1020 @@
+! =================================================================================================================================
+! MODULE       : stomate_alloc
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Allocate net primary production to: carbon reserves, aboveground sapwood,
+!! belowground sapwood, root, fruits and leaves.      
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_alloc
+
+  ! Modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE pft_parameters
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC alloc,alloc_clear
+
+ ! Variables shared by all subroutines in this module
+
+  LOGICAL, SAVE                                             :: firstcall_alloc = .TRUE.  !! Is this the first call? (true/false) 
+!$OMP THREADPRIVATE(firstcall_alloc)
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : alloc_clear
+!!
+!>\BRIEF          Set the flag ::firstcall_alloc to .TRUE. and as such activate section 
+!! 1.1 of the subroutine alloc (see below).\n
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE alloc_clear
+    firstcall_alloc = .TRUE.
+  END SUBROUTINE alloc_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: alloc
+!!
+!>\BRIEF         Allocate net primary production (= photosynthesis
+!! minus autothrophic respiration) to: carbon reserves, aboveground sapwood,
+!! belowground sapwood, root, fruits and leaves following Friedlingstein et al. (1999).
+!!
+!! DESCRIPTION (definitions, functional, design, flags):\n
+!! The philosophy underlying the scheme is that allocation patterns result from
+!! evolved responses that adjust carbon investments to facilitate capture of most
+!! limiting resources i.e. light, water and mineral nitrogen. The implemented scheme 
+!! calculates the limitation of light, water and nitrogen. However, nitrogen is not a 
+!! prognostic variable of the model and therefore soil temperature and soil moisture 
+!! are used as a proxy for soil nitrogen availability.\n
+!! Sharpe & Rykiel (1991) proposed a generic relationship between the allocation of 
+!! carbon to a given plant compartment and the availability of a particular resource:\n
+!! \latexonly 
+!!   \input{alloc1.tex}
+!! \endlatexonly
+!! \n
+!! where A is the allocation of biomass production (NPP) to a given compartment (either 
+!! leaves, stem, or roots). Xi and Yj are resource availabilities (e.g. light, water, 
+!! nutrient). For a given plant compartment, a resource can be of type X or Y. An increase 
+!! in a X-type resource will increase the allocation to compartment A. An increase in a 
+!! Y-type resource will, however, lead to a decrease in carbon allocation to that compartment. 
+!! In other words, Y-type resources are those for which uptake increases with increased 
+!! investment in the compartment in question. X-type resources, as a consequence of 
+!! trade-offs, are the opposite. For example, water is a Y-type resource for root allocation. 
+!! Water-limited conditions should promote carbon allocation to roots, which enhance water 
+!! uptake and hence minimize plant water stress. Negative relationships between investment 
+!! and uptake arise when increased investment in one compartment leads, as required for 
+!! conservation of mass, to decreased investment in a component involved in uptake of 
+!! that resource.\n
+!!
+!! The implemented scheme allocates carbon to the following components:\n
+!! - Carbon reserves;\n
+!! - Aboveground sapwood;\n
+!! - Belowground sapwood;\n
+!! - Roots;\n
+!! - Fruits/seeds and\n
+!! - Leaves.
+!! \n
+!!
+!! The allocation to fruits and seeds is simply a 10% "tax" of the total biomass 
+!! production.\n
+!! Following carbohydrate use to support budburst and initial growth, the 
+!! carbohydrate reserve is refilled. The daily amount of carbon allocated to the 
+!! reserve pool is proportional to leaf+root allocation (::LtoLSR and ::RtoLSR).\n
+!! Sapwood and root allocation (respectively ::StoLSR and ::RtoLSR) are proportional 
+!! to the estimated light and soil (water and nitrogen) stress (::Limit_L and 
+!! ::Limit_NtoW). Further, Sapwood allocation is separated in belowground sapwood 
+!! and aboveground sapwood making use of the parameter (:: alloc_sap_above_tree
+!! or ::alloc_sap_above_grass). For trees partitioning between above and 
+!! belowground compartments is a function of PFT age.\n 
+!! Leaf allocation (::LtoLSR) is calculated as the residual of root and sapwood 
+!! allocation (LtoLSR(:) = 1. - RtoLSR(:) - StoLSR(:).\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: f_alloc; fraction of NPP that is allocated to the 
+!! six different biomass compartments (leaves, roots, above and belowground wood, 
+!! carbohydrate reserves and fruits). DIMENSION(npts,nvm,nparts).
+!!
+!! REFERENCE(S)	:
+!! - Friedlingstein, P., G. Joel, C.B. Field, and Y. Fung (1999), Towards an allocation
+!! scheme for global terrestrial carbon models, Global Change Biology, 5, 755-770.\n
+!! - Sharpe, P.J.H., and Rykiel, E.J. (1991), Modelling integrated response of plants 
+!! to multiple stresses. In: Response of Plants to Multiple Stresses (eds Mooney, H.A., 
+!! Winner, W.E., Pell, E.J.), pp. 205-224, Academic Press, San Diego, CA.\n
+!! - Krinner G, Viovy N, de Noblet-Ducoudr N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! - Malhi, Y., Doughty, C., and Galbraith, D. (2011). The allocation of ecosystem net primary productivity in tropical forests, 
+!! Philosophical Transactions of the Royal Society B-Biological Sciences, 366, 3225-3245, DOI 10.1098/rstb.2011.0062.\n
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!!   \includegraphics[scale=0.5]{allocflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE alloc (npts, dt, &
+       lai, veget_cov_max, senescence, when_growthinit, &
+       moiavail_week, tsoil_month, soilhum_month, &
+       biomass, age, leaf_age, leaf_frac, rprof, f_alloc,&
+
+ !!xchen1111
+       delta_turnover, var_date, VPD, swdown,swdown_week, LtoLSR, StoLSR, RtoLSR)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: npts			!! Domain size - number of grid cells 
+                                                                                        !! (unitless)
+    REAL(r_std), INTENT(in)                                    :: dt			!! Time step of the simulations for stomate
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: lai			!! PFT leaf area index 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_cov_max		!! PFT "Maximal" coverage fraction of a PFT 
+                                                                                        !! (= ind*cn_ind) 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                   :: senescence		!! Is the PFT senescent?  - only for 
+                                                                                        !! deciduous trees (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: when_growthinit	!! Days since beginning of growing season 
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week		!! PFT moisture availability - integrated
+                                                                                        !! over a week (0-1, unitless) 
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)              :: tsoil_month		!! PFT soil temperature - integrated over 
+                                                                                        !! a month (K) 
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)              :: soilhum_month		!! PFT soil humidity - integrated over a 
+                                                                                        !! month (0-1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: age			!! PFT age (days)
+
+!! xchen add vpd for gpp simulation in Amazon                                   
+    REAL(r_std), DIMENSION(npts), INTENT (in)                  :: VPD              !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(npts), INTENT(IN)                   :: swdown               
+    REAL(r_std), DIMENSION(npts), INTENT(IN)                   :: swdown_week
+    REAL(r_std), DIMENSION(npts), INTENT(out)                  :: LtoLSR                !! Ratio between leaf-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(out)                  :: StoLSR                !! Ratio between sapwood-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(out)                  :: RtoLSR                !! Ratio between root-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+!! liuly above
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass		!! PFT total biomass 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age		!! PFT age of different leaf classes 
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac		!! PFT fraction of leaves in leaf age class
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: rprof                 !! [DISPENSABLE] PFT rooting depth - not 
+                                                                                        !! calculated in the current version of 
+                                                                                        !! the model (m) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out)       :: f_alloc		!! PFT fraction of NPP that is allocated to
+                                                                                        !! the different components (0-1, unitless)
+
+   !!xchen1111                                                                     
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: delta_turnover            !! Intermediate variable for turnover ??
+    INTEGER(i_std),INTENT(in)                                  :: var_date                  !! xchen Date (days) 
+    REAL(r_std)                                                :: tmp_date             !! temporary for turnover calculation
+    REAL(r_std)                                                :: left_days             !! temporary for turnover calculation
+    REAL(r_std)                                                :: scale_factor             !! temporary for turnover calculation
+!! liuly above
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(nvm)                                :: lai_happy		!! Lai threshold below which carbohydrate 
+                                                                                        !! reserve may be used 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: limit_L		!! Lights stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N		!! Total nitrogen stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N_temp		!! Stress from soil temperature on nitrogen
+                                                                                        !! mineralisation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N_hum		!! Stress from soil humidity on nitrogen 
+                                                                                        !! mineralisation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_W		!! Soil water stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_WorN		!! Most limiting factor in the soil: 
+                                                                                        !! nitrogen or water (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit			!! Most limiting factor: amongst limit_N, 
+                                                                                        !! limit_W and limit_L (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: t_nitrogen		!! Preliminairy soil temperature stress 
+                                                                                        !! used as a proxy for nitrogen stress (K)
+    REAL(r_std), DIMENSION(npts)                               :: h_nitrogen		!! Preliminairy soil humidity stress used 
+                                                                                        !! as a proxy for nitrogen stress 
+                                                                                        !! (unitless)  
+    REAL(r_std), DIMENSION(npts)                               :: rpc			!! Scaling factor for integrating vertical
+                                                                                        !!  soil profiles (unitless) 	
+!! liulya xchen comment below 3 vars and move to outvars
+    !  REAL(r_std), DIMENSION(npts)                               :: LtoLSR		!! Ratio between leaf-allocation and 
+   !                                                                                      !! (leaf+sapwood+root)-allocation 
+   !                                                                                      !! (0-1, unitless)
+   !  REAL(r_std), DIMENSION(npts)                               :: StoLSR		!! Ratio between sapwood-allocation and 
+   !                                                                                      !! (leaf+sapwood+root)-allocation 
+   !                                                                                      !! (0-1, unitless)
+   !  REAL(r_std), DIMENSION(npts)                               :: RtoLSR		!! Ratio between root-allocation and 
+   !                                                                                      !! (leaf+sapwood+root)-allocation 
+   !                                                                                      !! (0-1, unitless)
+!! liulya above
+    REAL(r_std), DIMENSION(npts)                               :: carb_rescale		!! Rescaling factor for allocation factors
+                                                                                        !! if carbon is allocated to carbohydrate 
+                                                                                        !! reserve (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: use_reserve		!! Mass of carbohydrate reserve used to 
+                                                                                        !! support growth 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+!!xchen1111
+    REAL(r_std), DIMENSION(npts)                               :: var_use_reserve       !! Mass of carbohydrate reserve used to  
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+
+    REAL(r_std), DIMENSION(npts)                               :: transloc_leaf		!! Fraction of carbohydrate reserve used 
+                                                                                        !! (::use_reserve) to support leaf growth 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: leaf_mass_young	!! Leaf biomass in youngest leaf age class 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lm_old		!! Variable to store leaf biomass from 
+                                                                                        !! previous time step 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std)                                                :: reserve_time		!! Maximum number of days during which 
+                                                                                        !! carbohydrate reserve may be used (days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_around		!! lai on natural part of the grid cell, or
+                                                                                        !! of agricultural PFTs 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                           :: veget_cov_max_nat 	!! Vegetation cover of natural PFTs on the 
+                                                                                        !! grid cell (agriculture masked) 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: natveg_tot		!! Total natural vegetation cover on 
+                                                                                        !! natural part of the grid cell 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: lai_nat		!! Average LAI on natural part of the grid
+                                                                                        !! cell @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: zdiff_min		!! [DISPENSABLE] intermediate array for 
+                                                                                        !! looking for minimum
+    REAL(r_std), DIMENSION(npts)                               :: alloc_sap_above	!! Prescribed fraction of sapwood 
+                                                                                        !! allocation to above ground sapwood 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: z_soil                !! Variable to store depth of the different
+                                                                                        !! soil layers (m)
+!$OMP THREADPRIVATE(z_soil)
+    INTEGER(i_std)                                             :: i,j,l,m		!! Indices (unitless)
+    INTEGER(i_std)                                             :: ier                   !! Error handling
+
+    REAL(r_std), DIMENSION(npts)                               :: old_LtoLSR     !!xchen2017 Ratio between leaf-allocation and  liulyq what is this?
+    REAL(r_std), DIMENSION(npts)                               :: old_StoLSR     !!liulya
+    REAL(r_std), DIMENSION(npts)                               :: old_rtoLSR     !!liulya
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_cl1        !! @xchen to add lai of each leaf class age and for calculating PC in wu's science paper
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_cl2                     
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_cl3                     
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_cl4                     
+    REAL(r_std), DIMENSION(npts,nvm)                           :: sla_age2           
+    REAL(r_std), DIMENSION(npts,nvm)                           :: sla_age3           
+    REAL(r_std), DIMENSION(npts,nvm)                           :: sla_age4  
+    REAL(r_std)                                                :: lly_var1           !! temporary for allocation function (unitless) !!liulye
+    REAL(r_std)                                                :: lly_var2           !! temporary for allocation function (unitless) !!liulye
+    REAL(r_std)                                                :: lly_var3  
+
+
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering alloc'
+
+    lly_var1 = alloc_para1
+    lly_var2 = alloc_para2
+    lly_var3 = alloc_para3
+
+   WRITE(numout,*) 'number of var_days in stomat_allocation: ',var_date
+
+   
+    tmp_date = var_date
+    IF ( tmp_date == 0) THEN
+      tmp_date = 365
+    END IF
+
+    left_days = 365 - tmp_date
+
+    WRITE(numout,*) 'number of tmp_date in stomat_alloc: ',tmp_date
+    WRITE(numout,*) 'number of left_days in stomat_alloc: ',left_days
+
+    IF ( tmp_date > 180 ) THEN
+
+    scale_factor = ((-1 * (tmp_date - 180 - 92) **2) + 8000)/8000 + 1.1
+    WRITE(numout,*) 'number of scale_factor in stomat_alloc: ',scale_factor
+
+    END IF
+
+
+!! 1. Initialize
+
+    !! 1.1 First call only
+    IF ( firstcall_alloc ) THEN
+
+       !
+       ! 1.1.0 Initialization
+       !
+       L0(2:nvm) = un - R0(2:nvm) - S0(2:nvm)  
+       IF ((MINVAL(L0(2:nvm)) .LT. zero) .OR. (MAXVAL(S0(2:nvm)) .EQ. un)) THEN
+          CALL ipslerr_p (3,'in module stomate_alloc', &
+               &           'Something wrong happened', &
+               &           'L0 negative or division by zero if S0 = 1', &
+               &           '(Check your parameters.)')
+       ENDIF
+
+       
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nslm) 
+       !        previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90  
+       ALLOCATE(z_soil(0:nslm), stat=ier)
+       IF ( ier /= 0 ) CALL ipslerr_p(3,'stomate_alloc','Pb in allocate of z_soil','','')
+       z_soil(0) = zero
+       z_soil(1:nslm) = diaglev(1:nslm)
+
+       !! 1.1.2 Print flags and parameter settings
+       IF (printlev >= 2) THEN
+          WRITE(numout,*) 'alloc:'
+          WRITE(numout,'(a,$)') '    > We'
+          IF ( .NOT. ok_minres ) WRITE(numout,'(a,$)') ' do NOT'
+          WRITE(numout,*) 'try to reach a minumum reservoir when severely stressed.'
+          WRITE(numout,*) '   > Time delay (days) to build leaf mass (::tau_leafinit): ', &
+               tau_leafinit(:)
+          WRITE(numout,*) '   > Curvature of root mass with increasing soil depth (::z_nitrogen): ', &
+               z_nitrogen
+          WRITE(numout,*) '   > Sap allocation above the ground / total sap allocation (0-1, unitless): '
+          WRITE(numout,*) '       grasses (::alloc_sap_above_grass) :', alloc_sap_above_grass
+          WRITE(numout,*) '   > Default root alloc fraction (1; ::R0): ', R0(:)
+          WRITE(numout,*) '   > Default sapwood alloc fraction (1; ::S0): ', S0(:)
+          WRITE(numout,*) '   > Default fruit allocation (1, ::f_fruit): ', f_fruit
+          WRITE(numout,*) '   > Minimum (min_LtoLSR)/maximum (::max_LtoLSR)leaf alloc fraction (0-1, unitless): ',&
+               min_LtoLSR,max_LtoLSR
+          WRITE(numout,*) '   > Maximum time (days) the carbon reserve can be used:'
+          WRITE(numout,*) '       trees (reserve_time_tree):',reserve_time_tree
+          WRITE(numout,*) '       grasses (reserve_time_grass):',reserve_time_grass
+       END IF
+       firstcall_alloc = .FALSE.
+
+    ENDIF
+
+
+    !! 1.2 Every call
+    !! 1.2.1 Reset output variable (::f_alloc)
+    f_alloc(:,:,:) = zero
+    f_alloc(:,:,icarbres) = un
+
+ 
+    !! 1.2.2 Proxy for soil nitrogen stress
+    !        Nitrogen availability and thus N-stress can not be calculated by the model. Water and
+    !        temperature stress are used as proxy under the assumption that microbial activity is 
+    !        determined by soil temperature and water availability. In turn, microbial activity is 
+    !         assumed to be an indicator for nitrogen mineralisation and thus its availability. 
+
+    !! 1.2.2.1 Convolution of nitrogen stress with root profile 
+    !          Here we calculate preliminary soil temperature and soil humidity stresses that will be used 
+    !          as proxies for nitrogen stress. Their calculation follows the nitrogen-uptake capacity of roots.
+    !          The capacity of roots to take up nitrogen is assumed to decrease exponentially with 
+    !          increasing soil depth. The curvature of the exponential function describing the 
+    !          nitrogen-uptake capacity of roots (= root mass * uptake capacity) is given by 
+    !          ::z_nitrogen. Strictly speaking its unit is meters (m). Despite its units this parameter 
+    !          has no physical meaning.
+    !          Because the roots are described by an exponential function but the soil depth is limited to
+    !          ::z_soil(nslm), the root profile is truncated at ::z_soil(nslm). For numerical reasons, 
+    !          the total capacity of the soil profile for nitrogen uptake should be 1. To this aim a scaling
+    !          factor (::rpc) is calculated as follows:\n
+    !          \latexonly
+    !            \input{alloc2.tex} 
+    !          \endlatexonly
+    !          Then temperature (::t_nitrogen) and humidity (::h_nitrogen) proxies for nitrogen stress are 
+    !          calculated using mean weighted (weighted by nitrogen uptake capacity) soil temperature (::tsoil_month)
+    !          or soil moisture (::soil_hum_month) (calculated in stomate_season.f90). 
+    !          \latexonly
+    !            \input{alloc3.tex} 
+    !          \endlatexonly
+    !          \latexonly
+    !            \input{alloc4.tex} 
+    !          \endlatexonly	
+    !          \n 
+		  
+    ! Scaling factor for integration
+    rpc(:) = un / ( un - EXP( -z_soil(nslm) / z_nitrogen ) )
+
+    ! Integrate over # soil layers
+    t_nitrogen(:) = zero
+
+    DO l = 1, nslm ! Loop over # soil layers
+
+       t_nitrogen(:) = &
+            t_nitrogen(:) + tsoil_month(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
+
+    ENDDO ! Loop over # soil layers
+
+ 
+!!$    !! 1.2.2.2 Convolution for soil moisture
+!!$    !          Scaling factor for integration
+!!$    rpc(:) = 1. / ( 1. - EXP( -z_soil(nslm) / z_nitrogen ) )
+
+    ! Integrate over # soil layers
+    h_nitrogen(:) = zero
+
+    DO l = 1, nslm ! Loop over # soil layers
+
+       h_nitrogen(:) = &
+            h_nitrogen(:) + soilhum_month(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
+
+    ENDDO ! Loop over # soil layers
+
+
+    !! 1.2.3 Separate between natural and agrigultural LAI
+    !        The model distinguishes different natural PFTs but does not contain information
+    !        on whether these PFTs are spatially separated or mixed. In line with the DGVM the 
+    !        models treats the natural PFT's as mixed. Therefore, the average LAI over the
+    !        natural PFTs is calculated to estimate light stress. Agricultural PFTs are spatially
+    !        separated. 
+    natveg_tot(:) = zero
+    lai_nat(:) = zero
+
+    DO j = 2, nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+          ! Mask agricultural vegetation
+          veget_cov_max_nat(:,j) = veget_cov_max(:,j)
+       ELSE
+          ! Mask natural vegetation
+          veget_cov_max_nat(:,j) = zero
+       ENDIF
+
+       ! Sum up fraction of natural space covered by vegetation
+       natveg_tot(:) = natveg_tot(:) + veget_cov_max_nat(:,j)
+
+       ! Sum up lai
+       lai_nat(:) = lai_nat(:) + veget_cov_max_nat(:,j) * lai(:,j)
+
+    ENDDO ! Loop over # PFTs
+
+    DO j = 2, nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+
+          ! Use the mean LAI over all natural PFTs when estimating light stress 
+          ! on a specific natural PFT
+          lai_around(:,j) = lai_nat(:)
+       ELSE
+
+          ! Use the actual LAI (specific for that PFT) when estimating light
+          ! stress on a specific agricultural PFT
+          lai_around(:,j) = lai(:,j)
+       ENDIF
+
+    ENDDO ! Loop over # PFTs
+
+
+    !! 1.2.4 Calculate LAI threshold below which carbohydrate reserve is used.
+    !        Lai_max is a PFT-dependent parameter specified in stomate_constants.f90
+    lai_happy(:) = lai_max(:) * lai_max_to_happy(:)
+
+ !! 2. Use carbohydrate reserve to support growth and update leaf age
+
+    ! Save old leaf mass, biomass got last updated in stomate_phenology.f90
+    lm_old(:,:) = biomass(:,:,ileaf,icarbon)
+
+    DO j = 2, nvm ! Loop over # PFTs 
+
+       !! 2.1 Calculate demand for carbohydrate reserve to support leaf and root growth.
+       !      Maximum time (days) since start of the growing season during which carbohydrate 
+       !      may be used
+       IF ( is_tree(j) ) THEN
+          reserve_time = reserve_time_tree
+       ELSE
+          reserve_time = reserve_time_grass
+       ENDIF
+
+       ! Growth is only supported by the use of carbohydrate reserves if the following 
+       ! conditions are  statisfied:\n
+       ! - PFT is not senescent;\n
+       ! - LAI must be low (i.e. below ::lai_happy) and\n
+       ! - Day of year of the simulation is in the beginning of the growing season.
+       WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. & 
+            ( .NOT. senescence(:,j) ) .AND. &
+            ( lai(:,j) .LT. lai_happy(j) ) .AND. &
+            ( when_growthinit(:,j) .LT. reserve_time ) ) 
+
+          ! Determine the mass from the carbohydrate reserve that can be used @tex $(gC m^{-2})$ @endtex. 
+          ! Satisfy the demand or use everything that is available 
+          ! (i.e. ::biomass(:,j,icarbres)). Distribute the demand evenly over the time 
+          ! required (::tau_leafinit) to develop a minimal canopy from reserves (::lai_happy). 
+          use_reserve(:) = &
+               MIN( biomass(:,j,icarbres,icarbon), &
+               deux * dt/tau_leafinit(j) * lai_happy(j)/ sla(j) )
+
+          ! Distribute the reserve over leaves and fine roots.
+	  ! The part of the reserve going to the leaves is the ratio of default leaf allocation to default root and leaf allocation.
+	  ! The remaining of the reserve is alocated to the roots.
+          transloc_leaf(:) = L0(j)/(L0(j)+R0(j)) * use_reserve(:)
+          biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) + transloc_leaf(:)
+          biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) + ( use_reserve(:) - transloc_leaf(:) )
+
+          ! Adjust the carbohydrate reserve mass by accounting for the reserves allocated to leaves and roots during
+          ! this time step
+          biomass(:,j,icarbres,icarbon) = biomass(:,j,icarbres,icarbon) - use_reserve(:)
+
+       ELSEWHERE
+
+          transloc_leaf(:) = zero
+
+       ENDWHERE
+    
+       !! 2.2 Update leaf age
+       !! 2.2.1 Decrease leaf age in youngest class
+       !        Adjust the mass of the youngest leaves by the newly grown leaves
+       leaf_mass_young(:) = leaf_frac(:,j,1) * lm_old(:,j) + transloc_leaf(:)
+
+       WHERE ( ( transloc_leaf(:) .GT. min_stomate ) .AND. ( leaf_mass_young(:) .GT. min_stomate ) )
+          
+          ! Adjust leaf age by the ratio of leaf_mass_young (t-1)/leaf_mass_young (t) 
+          leaf_age(:,j,1) = MAX( zero, leaf_age(:,j,1) * ( leaf_mass_young(:) - transloc_leaf(:) ) / &
+               leaf_mass_young(:) )
+
+       ENDWHERE
+
+       !! 2.2.2 Update leaf mass fraction for the different age classes
+       !        Mass fraction in the youngest age class is calculated as the ratio between
+       !        the new mass in the youngest class and the total leaf biomass 
+       !        (inc. the new leaves)
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+          
+          leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf,icarbon)
+
+       ENDWHERE
+
+
+       ! Mass fraction in the other classes is calculated as the ratio bewteen
+       ! the current mass in that age and the total leaf biomass 
+       ! (inc. the new leaves)\n
+       DO m = 2, nleafages ! Loop over # leaf age classes
+
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+
+       ENDDO ! Loop over # leaf age classes
+
+    ENDDO ! loop over # PFTs
+
+!! liulya copy from xchen    , sla_max -> sla
+    DO j = 2,nvm                                                              
+      sla_age2(:,j) = sla(j)*0.9 !!0.9                                           
+      sla_age3(:,j) = sla(j)*0.85 !!0.85                                          
+      sla_age4(:,j) = sla(j)*0.8 !!0.8                                          
+   ENDDO                                                                       
+   lai_cl2(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,2)*sla_age2(:,:)    
+   lai_cl3(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,3)*sla_age3(:,:)    
+   lai_cl4(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,4)*sla_age4(:,:)    
+   lai_cl1(:,:) = lai(:,:) - lai_cl2(:,:) -lai_cl3(:,:) -lai_cl4(:,:) 
+!! liulya copy from xchen 
+
+
+ !! 3. Calculate allocatable fractions of biomass production (NPP) 
+     
+    ! Calculate fractions of biomass production (NPP) to be allocated to the different 
+    ! biomass components.\n
+    ! The fractions of NPP allocated (0-1, unitless) to the different compartments depend on the
+    ! availability of light, water, and nitrogen.
+    DO j = 2, 2 ! Loop over # PFTs
+    !! liulyw Xiuzhi modified here as j = 2, 2 for tropical evergreen forest
+       ! Reset values
+       RtoLSR(:) = zero
+       LtoLSR(:) = zero
+       StoLSR(:) = zero
+
+       ! For trees, partitioning between above and belowground sapwood biomass is a function 
+       ! of age. An older tree gets more allocation to the aboveground sapwoood than a younger tree.
+       ! For the other PFTs it is prescribed. 
+       ! ::alloc_min, ::alloc_max and ::demi_alloc are specified in stomate_constants.f90
+       IF ( is_tree(j) ) THEN
+
+          alloc_sap_above(:) = alloc_min(j)+(alloc_max(j)-alloc_min(j))*(un-EXP(-age(:,j)/demi_alloc(j)))
+       
+       ELSE
+          
+          alloc_sap_above(:) = alloc_sap_above_grass
+       
+       ENDIF
+
+
+       !! 3.1 Calculate light stress, water stress and proxy for nitrogen stress.\n
+       !      For the limiting factors a low value indicates a strong limitation
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+          !! 3.1.1 Light stress
+          !        Light stress is a function of the mean lai on the natural part of the grid box 
+          !        and of the PFT-specific LAI for agricultural crops. In line with the DGVM, natural
+          !        PFTs in the same gridbox are treated as if they were spatially mixed whereas 
+          !        agricultural PFTs are considered to be spatially separated.
+          !        The calculation of the lights stress depends on the extinction coefficient (set to 0.5)
+          !        and of a mean LAI.
+          WHERE( lai_around(:,j) < max_possible_lai )
+
+             limit_L(:) = MAX( 0.1_r_std, EXP( -ext_coeff(j) * lai_around(:,j) ) )
+          
+          ELSEWHERE
+             
+             limit_L(:) = 0.1_r_std
+          
+          ENDWHERE
+
+          !! 3.1.2 Water stress
+          !        Water stress is calculated as the weekly moisture availability.
+          !        Weekly moisture availability is calculated in stomate_season.f90.
+          limit_W(:) = MAX( 0.1_r_std, MIN( un, moiavail_week(:,j) ) )
+
+
+          !! 3.1.3 Proxy for nitrogen stress
+          !         The proxy for nitrogen stress depends on monthly soil water availability
+          !         (::soilhum_month) and monthly soil temperature (::tsoil_month). See section
+          !         1.2.2 for details on how ::t_nitrogen and ::h_nitrogen were calculated.\n
+          !         Currently nitrogen-stress is calculated for both natural and agricultural PFTs.
+          !         Due to intense fertilization of agricultural PFTs this is a strong 
+          !         assumption for several agricultural regions in the world (US, Europe, India, ...)
+          !         Water stress on nitrogen mineralisation 
+          limit_N_hum(:) = MAX( undemi, MIN( un, h_nitrogen(:) ) )
+
+	  ! Temperature stress on nitrogen mineralisation using a Q10 decomposition model
+          ! where Q10 was set to 2
+          limit_N_temp(:) = 2.**((t_nitrogen(:) - ZeroCelsius - Nlim_tref )/Nlim_Q10)
+          limit_N_temp(:) = MAX( 0.1_r_std, MIN( un, limit_N_temp(:) ) )
+
+          ! Combine water and temperature factors to get total nitrogen stress
+          limit_N(:) = MAX( 0.1_r_std, MIN( un, limit_N_hum(:) * limit_N_temp(:) ) )
+
+          ! Take the most limiting factor among soil water and nitrogen 
+          limit_WorN(:) = MIN( limit_W(:), limit_N(:) )
+
+          ! Take the most limiting factor among aboveground (i.e. light) and belowground 
+          ! (i.e. water & nitrogen) limitations
+          limit(:) = MIN( limit_WorN(:), limit_L(:) )
+
+          !! 3.2 Calculate ratio between allocation to leaves, sapwood and roots
+          !      Partitioning between belowground and aboveground biomass components is assumed 
+          !      to be proportional to the ratio of belowground and aboveground stresses.\n
+          !      \latexonly 
+          !        \input{alloc1.tex} 
+          !      \endlatexonly
+          !      Root allocation is the default root allocation corrected by a normalized ratio of aboveground stress to total stress.
+	       !      The minimum root allocation is 0.15.
+          RtoLSR(:) = &
+               MAX( .15_r_std, &
+               R0(j) * trois * limit_L(:) / ( limit_L(:) + deux * limit_WorN(:) ) )
+
+          ! Sapwood allocation is the default sapwood allocation corrected by a normalized ratio of belowground stress to total stress.
+          StoLSR(:) = S0(j) * 3. * limit_WorN(:) / ( 2._r_std * limit_L(:) + limit_WorN(:) )
+
+          ! Leaf allocation is calculated as the remaining allocation fraction
+          ! The range of variation of leaf allocation is constrained by ::min_LtoLSR and ::max_LtoLSR. 
+          
+          
+          LtoLSR(:) = 1.0 - RtoLSR(:) - StoLSR(:)
+         
+          !! liulya
+          old_StoLSR(:) = StoLSR(:)
+          old_RtoLSR(:) = RtoLSR(:)
+         
+          !! Liuly xchen
+          old_LtoLSR(:) = LtoLSR(:)
+
+          LtoLSR(:) = MIN((ABS(swdown_week(:))*EXP(-0.5*(lai_cl4(:,j)))/lly_var1)**lly_var2*LtoLSR(:), 0.90)
+         !  LtoLSR(:) = MIN((ABS(swdown_week(:))*EXP(-0.5*(lai_cl4(:,j)))/30.0)**3.0*LtoLSR(:), 0.90)
+          LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) )
+
+          ! Roots allocation is recalculated as the residual carbon after leaf allocation has been calculated. 
+            !  RtoLSR(:) = un - LtoLSR(:) - StoLSR(:)
+          !!VPD and water stress
+          StoLSR(:) = MAX(0.05, StoLSR(:) - 0.5*(LtoLSR(:)-old_LtoLSR(:)))
+          StoLSR(:) = 0.41*StoLSR(:)
+          !!StoLSR(:) = 1.0 - LtoLSR(:) - RtoLSR(:)
+          RtoLSR = 1.0 -  LtoLSR(:) - StoLSR(:)
+
+       !!ENDWHERE !! liulyw change based on xchen
+	   
+       ! Check whether allocation needs to be adjusted. If LAI exceeds maximum LAI 
+       ! (::lai_max), no addition carbon should be allocated to leaf biomass. Allocation is 
+       ! then partioned between root and sapwood biomass.
+       WHERE ( (biomass(:,j,ileaf,icarbon) .GT. min_stomate) .AND. (lai(:,j) .GT. lai_max(j)) )
+
+          StoLSR(:) = StoLSR(:) + 0.41*LtoLSR(:)
+          LtoLSR(:) = zero
+          RtoLSR = 1.0 -  LtoLSR(:) - StoLSR(:) !! liuly add from xchen
+
+       ENDWHERE
+      ENDWHERE !! liulyw change based on xchen
+
+      !! liulyq below add based on xchen's version 
+      ! WRITE(numout,*) 'LtoLSR', LtoLSR(:)
+      ! WRITE(numout,*) 'RtoLSR', RtoLSR(:)                                            
+      ! WRITE(numout,*) 'StoLSR', StoLSR(:)  
+      ! WRITE(numout,*) 'Timestep', dt  
+      WRITE(numout,*) 'liulyp ALLOC_PARA1 is:', lly_var1
+      WRITE(numout,*) 'liulyp ALLOC_PARA2 is:', lly_var2
+      CALL xios_orchidee_send_field("oLtoLSR",old_LtoLSR(:))                         
+      CALL xios_orchidee_send_field("oRtoLSR",old_RtoLSR(:))                           
+      CALL xios_orchidee_send_field("oStoLSR",old_StoLSR(:)) 
+
+      CALL xios_orchidee_send_field("LtoLSR",LtoLSR(:))                         
+      CALL xios_orchidee_send_field("RtoLSR",RtoLSR(:))                           
+      CALL xios_orchidee_send_field("StoLSR",StoLSR(:))
+
+       !! 3.3 Calculate the allocation fractions.
+       !      The allocation fractions (::f_alloc) are an output variable (0-1, unitless). f_alloc
+       !      has three dimensions (npts,nvm,nparts). Where ::npts is the number of grid cells, ::nvm is the 
+       !      number of PFTs and ::nparts the number of biomass components. Currently six biomass compartments
+       !      are distinguished: (1) Carbon reserves, (2) Aboveground sapwood, (3) Belowground 
+       !      sapwood, (4) Roots, (5) fruits/seeds and (6) Leaves.@tex $(gC m^{-2})$ @endtex \n
+       DO i = 1, npts ! Loop over grid cells 
+
+          IF ( biomass(i,j,ileaf,icarbon) .GT. min_stomate ) THEN
+      
+             IF ( senescence(i,j) ) THEN
+                
+                !! 3.3.1 Allocate all C to carbohydrate reserve
+                !        If the PFT is senescent allocate all C to carbohydrate reserve, 
+                !        then the allocation fraction to reserves is 1. 
+                f_alloc(i,j,icarbres) = un
+
+             ELSE
+
+                !! 3.3.2 Allocation during the growing season  
+                f_alloc(i,j,ifruit) = f_fruit
+
+
+                ! Allocation to the carbohydrate reserve is proportional to leaf and root 
+                ! allocation. If carbon is allocated to the carbohydrate reserve, rescaling 
+                ! of allocation factors is required to ensure carbon mass preservation.\n
+                ! Carbon is allocated to the carbohydrate reserve when the pool size of the 
+                ! reserve is less than the carbon needed to grow a canopy twice the size of 
+                ! the maximum LAI (::lai_max). Twice the size was used as a threshold because
+                ! the reserves needs to be sufficiently to grow a canopy and roots. In case 
+                ! the carbohydrate pool is full, there is no need to rescale the other
+                ! allocation factors.
+	               ! If there is no rescaling of the allocation factors (carbres=1, no carbon put
+                  ! to reserve), then fraction remaining after fruit allocation (1-fruit_alloc) 
+                  ! is distributed between leaf, root and sap (sap carbon also distributed between   
+                  ! sap_above and sap_below with factor alloc_sap_above).
+                  ! If carbon is allocated to the carbohydrate reserve, all these factors are 
+                  ! rescaled through carb_rescale, and an allocation fraction for carbohydrate pool 
+                  ! appears. carb_rescale depends on the parameter (::ecureuil). 
+                ! (::ecureuil) is the fraction of primary leaf and root allocation put into 
+                ! reserve, it is specified in stomate_constants.f90 and is either 0 or 1.
+                IF ( ( biomass(i,j,icarbres,icarbon)*sla(j) ) .LT. 2*lai_max(j) ) THEN
+                !!IF ( ( biomass(i,j,icarbres,icarbon)*sla_calc(i,j) ) .LT. 2*lai_max(j) ) THEN !! liulya mod by on xchen
+                   carb_rescale(i) = un / ( un + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
+                ELSE
+                   carb_rescale(i) = un
+                ENDIF
+
+                f_alloc(i,j,ileaf) = LtoLSR(i) * ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * &
+                     ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapbelow) = StoLSR(i) * ( un - alloc_sap_above(i) ) * &
+                     ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,iroot) = RtoLSR(i) * (un - f_alloc(i,j,ifruit) ) * carb_rescale(i)              
+                f_alloc(i,j,icarbres) = ( un - carb_rescale(i) ) * ( un - f_alloc(i,j,ifruit) )
+                !! liulya add IF by xchen
+                IF ( (printlev>=5) .AND. (j .EQ. 10) ) THEN
+                  WRITE(numout,*) 'f_alloc(i,10,ileaf)', f_alloc(i,10,ileaf)
+              ENDIF
+
+             ENDIF  ! Is senescent?
+
+          ENDIF  ! There are leaves
+
+       ENDDO  ! Loop over # pixels - domain size
+
+    ENDDO  ! loop over # PFTs
+
+   !! xchen liulyc for PFT3 to end
+    DO j = 3, nvm ! Loop over # PFTs
+
+      ! Reset values
+      RtoLSR(:) = zero
+      LtoLSR(:) = zero
+      StoLSR(:) = zero
+
+      ! For trees, partitioning between above and belowground sapwood biomass is a function 
+      ! of age. An older tree gets more allocation to the aboveground sapwoood than a younger tree.
+      ! For the other PFTs it is prescribed. 
+      ! ::alloc_min, ::alloc_max and ::demi_alloc are specified in stomate_constants.f90
+      IF ( is_tree(j) ) THEN
+
+         alloc_sap_above(:) = alloc_min(j)+(alloc_max(j)-alloc_min(j))*(un-EXP(-age(:,j)/demi_alloc(j)))
+      
+      ELSE
+         
+         alloc_sap_above(:) = alloc_sap_above_grass
+      
+      ENDIF
+
+
+      !! 3.1 Calculate light stress, water stress and proxy for nitrogen stress.\n
+      !      For the limiting factors a low value indicates a strong limitation
+      WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+         !! 3.1.1 Light stress
+         !        Light stress is a function of the mean lai on the natural part of the grid box 
+         !        and of the PFT-specific LAI for agricultural crops. In line with the DGVM, natural
+         !        PFTs in the same gridbox are treated as if they were spatially mixed whereas 
+         !        agricultural PFTs are considered to be spatially separated.
+         !        The calculation of the lights stress depends on the extinction coefficient (set to 0.5)
+         !        and of a mean LAI.
+         WHERE( lai_around(:,j) < max_possible_lai )
+
+            limit_L(:) = MAX( 0.1_r_std, EXP( -ext_coeff(j) * lai_around(:,j) ) )
+         
+         ELSEWHERE
+            
+            limit_L(:) = 0.1_r_std
+         
+         ENDWHERE
+
+         !! 3.1.2 Water stress
+         !        Water stress is calculated as the weekly moisture availability.
+         !        Weekly moisture availability is calculated in stomate_season.f90.
+         limit_W(:) = MAX( 0.1_r_std, MIN( un, moiavail_week(:,j) ) )
+
+
+         !! 3.1.3 Proxy for nitrogen stress
+         !         The proxy for nitrogen stress depends on monthly soil water availability
+         !         (::soilhum_month) and monthly soil temperature (::tsoil_month). See section
+         !         1.2.2 for details on how ::t_nitrogen and ::h_nitrogen were calculated.\n
+         !         Currently nitrogen-stress is calculated for both natural and agricultural PFTs.
+         !         Due to intense fertilization of agricultural PFTs this is a strong 
+         !         assumption for several agricultural regions in the world (US, Europe, India, ...)
+         !         Water stress on nitrogen mineralisation 
+         limit_N_hum(:) = MAX( undemi, MIN( un, h_nitrogen(:) ) )
+
+    ! Temperature stress on nitrogen mineralisation using a Q10 decomposition model
+         ! where Q10 was set to 2
+         limit_N_temp(:) = 2.**((t_nitrogen(:) - ZeroCelsius - Nlim_tref )/Nlim_Q10)
+         limit_N_temp(:) = MAX( 0.1_r_std, MIN( un, limit_N_temp(:) ) )
+
+         ! Combine water and temperature factors to get total nitrogen stress
+         limit_N(:) = MAX( 0.1_r_std, MIN( un, limit_N_hum(:) * limit_N_temp(:) ) )
+
+         ! Take the most limiting factor among soil water and nitrogen 
+         limit_WorN(:) = MIN( limit_W(:), limit_N(:) )
+
+         ! Take the most limiting factor among aboveground (i.e. light) and belowground 
+         ! (i.e. water & nitrogen) limitations
+         limit(:) = MIN( limit_WorN(:), limit_L(:) )
+
+         !! 3.2 Calculate ratio between allocation to leaves, sapwood and roots
+         !      Partitioning between belowground and aboveground biomass components is assumed 
+         !      to be proportional to the ratio of belowground and aboveground stresses.\n
+         !      \latexonly 
+         !        \input{alloc1.tex} 
+         !      \endlatexonly
+         !      Root allocation is the default root allocation corrected by a normalized ratio of aboveground stress to total stress.
+    !      The minimum root allocation is 0.15.
+         RtoLSR(:) = &
+              MAX( .15_r_std, &
+              R0(j) * trois * limit_L(:) / ( limit_L(:) + deux * limit_WorN(:) ) )
+
+         ! Sapwood allocation is the default sapwood allocation corrected by a normalized ratio of belowground stress to total stress.
+         StoLSR(:) = S0(j) * 3. * limit_WorN(:) / ( 2._r_std * limit_L(:) + limit_WorN(:) )
+
+         ! Leaf allocation is calculated as the remaining allocation fraction
+       ! The range of variation of leaf allocation is constrained by ::min_LtoLSR and ::max_LtoLSR. 
+         LtoLSR(:) = un - RtoLSR(:) - StoLSR(:)
+         LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) )
+
+         ! Roots allocation is recalculated as the residual carbon after leaf allocation has been calculated. 
+         RtoLSR(:) = un - LtoLSR(:) - StoLSR(:)
+
+      ENDWHERE
+     
+      ! Check whether allocation needs to be adjusted. If LAI exceeds maximum LAI 
+      ! (::lai_max), no addition carbon should be allocated to leaf biomass. Allocation is 
+      ! then partioned between root and sapwood biomass.
+      WHERE ( (biomass(:,j,ileaf,icarbon) .GT. min_stomate) .AND. (lai(:,j) .GT. lai_max(j)) )
+
+         StoLSR(:) = StoLSR(:) + LtoLSR(:)
+         LtoLSR(:) = zero
+
+      ENDWHERE
+
+      !! 3.3 Calculate the allocation fractions.
+      !      The allocation fractions (::f_alloc) are an output variable (0-1, unitless). f_alloc
+      !      has three dimensions (npts,nvm,nparts). Where ::npts is the number of grid cells, ::nvm is the 
+      !      number of PFTs and ::nparts the number of biomass components. Currently six biomass compartments
+      !      are distinguished: (1) Carbon reserves, (2) Aboveground sapwood, (3) Belowground 
+      !      sapwood, (4) Roots, (5) fruits/seeds and (6) Leaves.@tex $(gC m^{-2})$ @endtex \n
+      DO i = 1, npts ! Loop over grid cells 
+
+         IF ( biomass(i,j,ileaf,icarbon) .GT. min_stomate ) THEN
+     
+            IF ( senescence(i,j) ) THEN
+               
+               !! 3.3.1 Allocate all C to carbohydrate reserve
+               !        If the PFT is senescent allocate all C to carbohydrate reserve, 
+               !        then the allocation fraction to reserves is 1. 
+               f_alloc(i,j,icarbres) = un
+
+            ELSE
+
+               !! 3.3.2 Allocation during the growing season  
+               f_alloc(i,j,ifruit) = f_fruit
+
+
+               ! Allocation to the carbohydrate reserve is proportional to leaf and root 
+               ! allocation. If carbon is allocated to the carbohydrate reserve, rescaling 
+               ! of allocation factors is required to ensure carbon mass preservation.\n
+               ! Carbon is allocated to the carbohydrate reserve when the pool size of the 
+               ! reserve is less than the carbon needed to grow a canopy twice the size of 
+               ! the maximum LAI (::lai_max). Twice the size was used as a threshold because
+               ! the reserves needs to be sufficiently to grow a canopy and roots. In case 
+               ! the carbohydrate pool is full, there is no need to rescale the other
+               ! allocation factors.
+               ! If there is no rescaling of the allocation factors (carbres=1, no carbon put
+               ! to reserve), then fraction remaining after fruit allocation (1-fruit_alloc) 
+               ! is distributed between leaf, root and sap (sap carbon also distributed between   
+               ! sap_above and sap_below with factor alloc_sap_above).
+               ! If carbon is allocated to the carbohydrate reserve, all these factors are 
+               ! rescaled through carb_rescale, and an allocation fraction for carbohydrate pool 
+               ! appears. carb_rescale depends on the parameter (::ecureuil). 
+               ! (::ecureuil) is the fraction of primary leaf and root allocation put into 
+               ! reserve, it is specified in stomate_constants.f90 and is either 0 or 1.
+               IF ( ( biomass(i,j,icarbres,icarbon)*sla(j) ) .LT. 2*lai_max(j) ) THEN
+                  carb_rescale(i) = un / ( un + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
+               ELSE
+                  carb_rescale(i) = un
+               ENDIF
+
+               f_alloc(i,j,ileaf) = LtoLSR(i) * ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+               f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * &
+                    ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+               f_alloc(i,j,isapbelow) = StoLSR(i) * ( un - alloc_sap_above(i) ) * &
+                    ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+               f_alloc(i,j,iroot) = RtoLSR(i) * (un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+               !! liulyc
+               !!@xchen give constant fraction for tropical forest accoording to Weirdt (2011) and Malhi (2011)
+                    !@MDW120811 - allocation to leaves - based on Figure 6 of Malhi 2011 (2.42 * NPP canopy = NPP total) 
+                    !@MDW120811 - so 41.32% is going to the canopy and 5-15% of NPP canopy is going to fruits+flowers
+                    !@MDW120811 - but for Guyana data, the leaves contain 62% of the litterfall dataset, 
+                    !for km67 data 70% of total measured litterfall             
+                    !@MDW120811 - so this results in: 41.32% * 70% = 29%            
+               f_alloc(i,j,ileaf) = 0.30               !@MDW090413 -10+10% - sensitivity analysis 0.27, 0.33 
+               !(also in turnover module) std 0.30
+               f_alloc(i,j,iroot) = 0.15               !@MDW090413 -10+10% - sensitivity analysis 0.14, 0.17 std 0.15
+               f_alloc(i,j,isapabove) = 0.33           !@MDW090413 -10+10% - sensitivity analysis 0.30, 0,36 std 0.33
+               f_alloc(i,j,isapbelow) = 0.07           !@MDW090413 -10+10% - sensitivity analysis 0.06, 0.08 std 0.07
+               f_alloc(i,j,ifruit) = 0.1515            !@MDW090413 -10+10% - sensitivity analysis 0.14, 0.17 std 0.151
+
+
+               f_alloc(i,j,icarbres) = ( un - carb_rescale(i) ) * ( un - f_alloc(i,j,ifruit) )
+
+            ENDIF  ! Is senescent?
+
+         ENDIF  ! There are leaves
+
+      ENDDO  ! Loop over # pixels - domain size
+
+   ENDDO  ! loop over # PFTs
+
+
+
+    IF (printlev>=3) WRITE(numout,*) 'Leaving alloc'
+
+  END SUBROUTINE alloc
+
+END MODULE stomate_alloc
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_data.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_data.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_data.f90	(revision 8430)
@@ -0,0 +1,683 @@
+! =================================================================================================================================
+! MODULE 	: stomate_data
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_day, dt_sechiba, one_year
+  USE pft_parameters
+  USE defprec
+  
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: hori_index     !! Move to Horizontal indices
+!$OMP THREADPRIVATE(hori_index)
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horipft_index  !! Horizontal + PFT indices
+!$OMP THREADPRIVATE(horipft_index)
+
+  ! Land cover change
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip10_index   !! Horizontal + P10 indices
+!$OMP THREADPRIVATE(horip10_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip100_index  !! Horizontal + P100 indice
+!$OMP THREADPRIVATE(horip100_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip11_index   !! Horizontal + P11 indices
+!$OMP THREADPRIVATE(horip11_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip101_index  !! Horizontal + P101 indices
+!$OMP THREADPRIVATE(horip101_index)
+
+  INTEGER(i_std),SAVE :: itime                 !! time step
+!$OMP THREADPRIVATE(itime)
+  INTEGER(i_std),SAVE :: hist_id_stomate       !! STOMATE history file ID
+!$OMP THREADPRIVATE(hist_id_stomate)
+  INTEGER(i_std),SAVE :: hist_id_stomate_IPCC  !! STOMATE history file ID for IPCC output
+!$OMP THREADPRIVATE(hist_id_stomate_IPCC)
+  INTEGER(i_std),SAVE :: rest_id_stomate       !! STOMATE restart file ID
+!$OMP THREADPRIVATE(rest_id_stomate)
+
+  REAL(r_std),PARAMETER :: adapted_crit = 1. - ( 1. / euler ) !! critical value for being adapted (1-1/e) (unitless)
+  REAL(r_std),PARAMETER :: regenerate_crit = 1. / euler       !! critical value for being regenerative (1/e) (unitless)
+
+
+  ! private & public routines
+
+  PUBLIC data
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: data
+!!
+!>\BRIEF         This routine defines the values of the PFT parameters. It will print the values of the parameters for STOMATE
+!!               in the standard outputs of ORCHIDEE. 
+!!
+!! DESCRIPTION : This routine defines PFT parameters. It initializes the pheno_crit structure by tabulated parameters.\n
+!!               Some initializations are done for parameters. The SLA is calculated according *to* Reich et al (1992).\n
+!!               Another formulation by Reich et al(1997) could be used for the computation of the SLA.
+!!               The geographical coordinates might be used for defining some additional parameters
+!!               (e.g. frequency of anthropogenic fires, irrigation of agricultural surfaces, etc.). \n
+!!               For the moment, this possibility is not used. \n
+!!               The specifc leaf area (SLA) is calculated according Reich et al, 1992 by :
+!!               \latexonly
+!!               \input{stomate_data_SLA.tex}
+!!               \endlatexonly
+!!               The sapling (young) biomass for trees and for each compartment of biomass is calculated by :
+!!               \latexonly
+!!               \input{stomate_data_sapl_tree.tex}
+!!               \endlatexonly
+!!               The sapling biomass for grasses and for each compartment of biomass is calculated by :
+!!               \latexonly
+!!               \input{stomate_data_sapl_grass.tex}
+!!               \endlatexonly
+!!               The critical stem diameter is given by the following formula :
+!!               \latexonly
+!!               \input{stomate_data_stem_diameter.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences 
+!!                  between broadleaved and coniferous forests, specifically, the assumption that grasses grow 
+!!                  needles is not justified. Replacing the function with the one based on Reich et al. 1997. 
+!!                  Given that sla=100cm2/gDW at 9 months, sla is:
+!!                  sla=exp(5.615-0.46*ln(leaflon in months)) 
+!!                   \latexonly
+!!                   \input{stomate_data_SLA_Reich_97.tex}
+!!                   \endlatexonly
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!! - Reich PB, Walters MB, Ellsworth DS, (1992), Leaf life-span in relation to leaf, plant and 
+!! stand characteristics among diverse ecosystems. Ecological Monographs, Vol 62, pp 365-392.
+!! - Reich PB, Walters MB, Ellsworth DS (1997) From tropics to tundra: global convergence in plant 
+!!  functioning. Proc Natl Acad Sci USA, 94:13730 13734
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE data (npts, lalo, days_since_beg) !!xchen201712 liulyc date is days_since_beg from stomate, stomate io, LPj
+
+
+    !! 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)
+    INTEGER(i_std), INTENT(in)                   :: days_since_beg    !!xchen201712 liulyc date is days_since_beg from stomate, stomate io, LPj
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: j       !! Index (unitless)
+    REAL(r_std)                                  :: alpha   !! alpha's : (unitless)
+    REAL(r_std)                                  :: dia     !! stem diameter (m)
+    REAL(r_std)                                  :: csa_sap !! Crown specific area sapling @tex $(m^2.ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+
+    !- 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(:)
+    !
+
+!!xchen 201712
+    WRITE(numout,*) 'date in stomate_data: ', MOD(days_since_beg+365, 365) !!liuly  what is WRITE
+
+    !-coeff_maint_zero
+    coeff_maint_zero(:,ileaf) = cm_zero_leaf(:)
+    coeff_maint_zero(:,isapabove) = cm_zero_sapabove(:)
+    coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow(:)
+    coeff_maint_zero(:,iheartabove) = cm_zero_heartabove(:)
+    coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow(:)
+    coeff_maint_zero(:,iroot) = cm_zero_root(:)
+    coeff_maint_zero(:,ifruit) = cm_zero_fruit(:)
+    coeff_maint_zero(:,icarbres) = cm_zero_carbres(:)
+
+
+    IF ( printlev >= 2 ) WRITE(numout,*) 'data: PFT characteristics'
+
+    DO j = 2,nvm ! Loop over # PFTS 
+
+       IF ( printlev >= 2 ) WRITE(numout,'(a,i3,a,a)') '    > PFT#',j,': ', PFT_name(j)
+
+       !
+       ! 1 tree? (true/false)
+       !
+       IF ( printlev >= 2 ) WRITE(numout,*) '       tree: (::is_tree) ', is_tree(j)
+
+       !
+       ! 2 flamability (0-1, unitless)
+       !
+
+       IF ( printlev >= 2 ) WRITE(numout,*) '       litter flamability (::flam) :', flam(j)
+
+       !
+       ! 3 fire resistance (unitless)
+       !
+
+       IF ( printlev >= 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 >= 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*(mass_ratio_heart_sap *bm_sapl_leaf(2)*sla(j)/(pi*pipe_k1)) & 
+               &     **bm_sapl_leaf(3))/sla(j))**bm_sapl_leaf(4)
+
+          IF ( pheno_type(j) .NE. 1 ) THEN
+             ! not evergreen
+             bm_sapl(j,icarbres,icarbon) = bm_sapl_carbres * bm_sapl(j,ileaf,icarbon)
+          ELSE
+             bm_sapl(j,icarbres,icarbon) = zero
+          ENDIF ! (pheno_type_tab(j) .NE. 1 )
+
+          csa_sap = bm_sapl(j,ileaf,icarbon) / ( pipe_k1 / sla(j) )
+
+          dia = (mass_ratio_heart_sap * csa_sap * dia_coeff(1) / pi ) ** dia_coeff(2)
+
+          bm_sapl(j,isapabove,icarbon) = &
+               bm_sapl_sapabove * pipe_density * csa_sap * pipe_tune2 * dia ** pipe_tune3
+          bm_sapl(j,isapbelow,icarbon) = bm_sapl(j,isapabove,icarbon)
+
+          bm_sapl(j,iheartabove,icarbon) = bm_sapl_heartabove * bm_sapl(j,isapabove,icarbon)
+          bm_sapl(j,iheartbelow,icarbon) = bm_sapl_heartbelow * bm_sapl(j,isapbelow,icarbon)
+
+       ELSE
+
+          !> 5.2 grasses
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_grass.tex}
+          !!\endlatexonly
+
+          alpha = alpha_grass
+
+          IF ( natural(j) ) THEN
+             bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_nat / sla(j)
+          ELSE
+             bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_agri / sla(j)
+          ENDIF
+
+          bm_sapl(j,icarbres,icarbon) = init_sapl_mass_carbres *bm_sapl(j,ileaf,icarbon)
+
+          bm_sapl(j,isapabove,icarbon) = zero
+          bm_sapl(j,isapbelow,icarbon) = zero
+
+          bm_sapl(j,iheartabove,icarbon) = zero
+          bm_sapl(j,iheartbelow,icarbon) = zero
+
+       ENDIF !( is_tree(j) )
+
+       bm_sapl(j,iroot,icarbon) = init_sapl_mass_root * (1./alpha) * bm_sapl(j,ileaf,icarbon)
+
+       bm_sapl(j,ifruit,icarbon) = init_sapl_mass_fruit  * bm_sapl(j,ileaf,icarbon)
+
+       IF ( printlev >= 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)
+       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 >= 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 / ((pipe_tune2*pipe_tune3)/(maxdia_coeff(1)**pipe_tune3)) ) &
+               ** ( un / ( pipe_tune3 - un ) ) ) * maxdia_coeff(2)
+          cn_sapl(j) = cn_sapl_init !crown of individual tree, first year
+
+       ELSE
+
+          maxdia(j) = undef
+          cn_sapl(j)=1
+
+       ENDIF !( is_tree(j) )
+
+       IF ( printlev >= 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 >= 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 >= 2 ) &
+            WRITE(numout,*) '       vernalization temperature (K): (::tcm_crit(j))', tcm_crit(j)
+
+       !
+       ! 10 critical values for phenology
+       !
+
+       ! 10.1 model used
+
+       IF ( printlev >= 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 >= 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 >= 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 >= 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 >= 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 >= 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 >= 2 ) &
+            WRITE(numout,*) '       type of senescence: (::senescence_type(j))',senescence_type(j)
+
+       ! 11.2 critical temperature for senescence (C)
+
+       IF ( ( printlev >= 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 >= 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)
+       END IF
+
+       ! 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 >= 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)
+       END IF
+       ! 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 >= 2 ) &
+            WRITE(numout,*) '       sapwood -> heartwood conversion time (d): (::tau_sap(j))', tau_sap(j)
+
+       !
+       ! 13 fruit lifetime (days)
+       !
+
+       IF ( printlev >= 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 >= 2 ) &
+            WRITE(numout,*) '       length of leaf death (d): (::leaffall(j))', leaffall(j)
+
+       !
+       ! 15 maximum lifetime of leaves (days)
+       !
+
+       IF ( ( printlev >= 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 >= 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 >= 2 ) &
+            WRITE(numout,*) '       initial LAI: (::lai_initmin(j))', lai_initmin(j)
+
+       !
+       ! 19 maximum LAI (m^2.m^{-2})
+       !
+
+       IF ( printlev >= 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 >= 2 ) &
+            WRITE(numout,*) '       reserve allocation factor: (::ecureuil(j))', ecureuil(j)
+
+       !
+       ! 21 maintenance respiration coefficient (g/g/day) at 0 deg C
+       !
+
+       IF ( printlev >= 2 ) THEN
+
+          WRITE(numout,*) '       maintenance respiration coefficient (g/g/day) at 0 deg C:'
+          WRITE(numout,*) '         . leaves: (::coeff_maint_zero(j,ileaf))',coeff_maint_zero(j,ileaf)
+          WRITE(numout,*) '         . sapwood above ground: (::coeff_maint_zero(j,isapabove)) ',&
+                        & coeff_maint_zero(j,isapabove)
+          WRITE(numout,*) '         . sapwood below ground: (::coeff_maint_zero(j,isapbelow))  ',&
+                       & coeff_maint_zero(j,isapbelow)
+          WRITE(numout,*) '         . heartwood above ground: (::coeff_maint_zero(j,iheartabove)) ',&
+                       & coeff_maint_zero(j,iheartabove)
+          WRITE(numout,*) '         . heartwood below ground: (::coeff_maint_zero(j,iheartbelow)) ',&
+                       & coeff_maint_zero(j,iheartbelow)
+          WRITE(numout,*) '         . roots: (::coeff_maint_zero(j,iroot))',coeff_maint_zero(j,iroot)
+          WRITE(numout,*) '         . fruits: (::coeff_maint_zero(j,ifruit)) ',coeff_maint_zero(j,ifruit)
+          WRITE(numout,*) '         . carbohydrate reserve: (::coeff_maint_zero(j,icarbres)) ',&
+                       & coeff_maint_zero(j,icarbres)
+
+       ENDIF !( printlev >= 2 )
+
+       !
+       ! 22 parameter for temperature sensitivity of maintenance respiration
+       !
+
+       IF ( printlev >= 2 ) THEN
+          WRITE(numout,*) '       temperature sensitivity of maintenance respiration (1/K) is'
+          WRITE(numout,*) '          a function of long term T (C): (::maint_resp_slope)'
+          WRITE(numout,*) '          ',maint_resp_slope(j,1),' + T *',maint_resp_slope(j,2), &
+               ' + T^2 *',maint_resp_slope(j,3)
+       END IF
+       !
+       ! 23 natural ?
+       !
+
+       IF ( printlev >= 2 ) &
+            WRITE(numout,*) '       Natural: (::natural(j))', natural(j)
+
+       !
+       ! 24 Vcmax et Vjmax (umol.m^{-2}.s^{-1}) 
+       !
+
+       IF ( printlev >= 2 ) &
+            WRITE(numout,*) '       Maximum rate of carboxylation: (::Vcmax_25(j))', Vcmax25(j) !!@xchen original is vcmax25(j)
+       !
+       ! 25 constants for photosynthesis temperatures
+       !
+
+       IF ( printlev >= 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 >= 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 >= 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 >= 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 stomate_data'
+
+  END SUBROUTINE data
+
+END MODULE stomate_data
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_io.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_io.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_io.f90	(revision 8430)
@@ -0,0 +1,2228 @@
+
+! =================================================================================================================================
+! MODULE       : stomate_io
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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 
+  !-
+  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, temp_air, dt_days, date_loc, &
+       &  ind, adapted, regenerate, moiavail_daily, gdd_init_date, litterhum_daily, &
+       &  t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+       &  soilhum_daily, precip_daily, &
+       &  gpp_daily, npp_daily, turnover_daily, &
+       &  moiavail_month, moiavail_week, t2m_longterm, tau_longterm, &
+       &  t2m_month, t2m_week, tsoil_month, soilhum_month, &
+       &  fireindex, firelitter, &
+       &  maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       &  minmoiavail_lastyear, minmoiavail_thisyear, &
+       &  maxgppweek_lastyear, maxgppweek_thisyear, &
+       &  gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
+       &  gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       &  PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+       &  maxfpc_lastyear, maxfpc_thisyear, &
+       &  turnover_longterm, gpp_week, biomass, resp_maint_part, &
+       &  leaf_age, leaf_frac, senescence, when_growthinit, age, &
+       &  resp_hetero, resp_maint, resp_growth, co2_fire, co2_to_bm_dgvm, co2_to_bm_radia, &
+       &  veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       &  time_hum_min, hum_min_dormance, &
+       &  litterpart, litter, dead_leaves, &
+       &  carbon, lignin_struc,turnover_time, &
+       &  prod10,prod100,flux10, flux100, &
+       &  convflux, cflux_prod10, cflux_prod100, &
+       &  prod10_harvest,prod100_harvest,flux10_harvest, flux100_harvest, &
+       &  convflux_harvest, cflux_prod10_harvest, cflux_prod100_harvest, &
+       &  convfluxpft, fDeforestToProduct, fLulccResidue, fHarvestToProduct, &
+       &  woodharvestpft, bm_to_litter, carb_mass_total, &
+       &  Tseason, Tseason_length, Tseason_tmp, & 
+       &  Tmin_spring_time, begin_leaves, onset_date, &
+       &  global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+       &  MatrixV, VectorU, previous_stock, current_stock, assim_param)
+
+    !---------------------------------------------------------------------
+    !- read start file
+    !---------------------------------------------------------------------
+    !-
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+    INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
+    ! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo
+    ! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution
+    REAL(r_std),DIMENSION(npts),INTENT(in)   :: temp_air                !! Air temperature from forcing file or coupled model (K)
+    !-
+    ! 0.2 output
+    !-
+    ! time step of STOMATE in days
+    REAL(r_std),INTENT(out) :: dt_days
+    ! date_loc (d)
+    INTEGER(i_std),INTENT(out) :: date_loc
+    ! density of individuals (1/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ind
+    ! Winter too cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: adapted
+    ! Winter sufficiently cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: regenerate
+    ! daily moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_daily
+    ! date for beginning of gdd count
+    REAL(r_std),DIMENSION(npts,2),INTENT(out) :: gdd_init_date
+    ! daily litter humidity
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: litterhum_daily
+    ! daily 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_daily
+    ! daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_min_daily
+    ! daily surface temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: tsurf_daily
+    ! daily soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nslm),INTENT(out) :: tsoil_daily
+    ! daily soil humidity
+    REAL(r_std),DIMENSION(npts,nslm),INTENT(out) :: soilhum_daily
+    ! daily precipitations (mm/day) (for phenology)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_daily
+    ! daily gross primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_daily
+    ! daily net primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_daily
+    ! daily turnover rates (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: turnover_daily
+    ! "monthly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_month
+    ! "weekly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_week
+    ! "long term" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_longterm
+    ! "tau_longterm"
+    REAL(r_std), INTENT(out)        :: tau_longterm
+    ! "monthly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_month
+    ! "seasonal" 2 meter temperatures (K) 
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason_length
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason_tmp
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: Tmin_spring_time
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: onset_date
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out)      :: begin_leaves
+
+    ! "weekly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_week
+    ! "monthly" soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nslm),INTENT(out) :: tsoil_month
+    ! "monthly" soil humidity
+    REAL(r_std),DIMENSION(npts,nslm),INTENT(out) :: soilhum_month
+    ! Probability of fire
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: fireindex
+    ! Longer term total litter above the ground, gC/m**2 of ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: firelitter
+    ! last year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_lastyear
+    ! this year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_thisyear
+    ! last year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_lastyear
+    ! this year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_thisyear
+    ! last year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_lastyear
+    ! this year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_thisyear
+    ! last year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: gdd0_lastyear
+    ! this year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: gdd0_thisyear
+    ! last year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_lastyear
+    ! this year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_thisyear
+    ! growing degree days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_m5_dormance
+    ! growing degree days, from begin of season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_from_growthinit
+    ! growing degree days since midwinter (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_midwinter
+    ! number of chilling days since leaves were lost (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ncd_dormance
+    ! number of growing days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ngd_minus5
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out)    :: PFTpresent
+    ! "long term" net primary productivity (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_longterm
+    ! last year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_lastyearmax
+    ! this year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_thisyearmax
+    ! last year's maximum fpc for each natural PFT, on ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_lastyear
+    ! this year's maximum fpc for each PFT,
+    ! on *total* ground (see stomate_season)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_thisyear
+    ! "long term" turnover rate (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: turnover_longterm
+    ! "weekly" GPP (gC/day/(m**2 covered)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_week
+    ! biomass (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: biomass
+    ! maintenance resp (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: resp_maint_part
+    ! leaf age (days)
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(out) :: leaf_age
+    ! fraction of leaves in leaf age class
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(out) :: leaf_frac
+    ! is the plant senescent ? 
+    !(only for deciduous trees - carbohydrate reserve)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: senescence
+    ! how many days ago was the beginning of the growing season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: when_growthinit
+    ! mean age (years)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: age
+    ! heterotrophic respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_hetero
+    ! maintenance respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_maint
+    ! growth respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_growth
+    ! carbon emitted into the atmosphere by fire (living and dead biomass)
+    ! (in gC/m**2/time step)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_fire
+    ! biomass uptaken (gC/(m**2 of total ground)/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_to_bm_dgvm
+    ! biomass uptaken (gC/(m**2 of total ground)/dt_sechiba)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_to_bm_radia
+    ! vegetation fractions (on ground) after last light competition
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: veget_lastlight
+    ! is the PFT everywhere in the grid box or very localized
+    ! (after its introduction)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: everywhere
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box?
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: need_adjacent
+    ! How much time ago was the PFT eliminated for the last time (y)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: RIP_time
+    ! time elapsed since strongest moisture availability (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: time_hum_min
+    ! minimum moisture during dormance
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: hum_min_dormance
+    ! fraction of litter above the ground belonging to different PFTs
+    ! separated for natural and agricultural PFTs.
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(out) :: litterpart
+    ! metabolic and structural litter, natural and agricultural,
+    ! above and below ground (gC/m**2)
+    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
+    ! carbon pool: active, slow, or passive, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,ncarb,nvm),INTENT(out) :: carbon
+    ! ratio Lignine/Carbon in structural litter, above and below ground,(gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(out) :: lignin_struc
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: turnover_time
+
+    ! For Spinup matrix resolution
+    INTEGER(i_std), INTENT(out) :: global_years   
+    LOGICAL, DIMENSION(npts), INTENT(out) :: ok_equilibrium
+    REAL(r_std), DIMENSION(npts), INTENT(out) :: nbp_accu  !! Accumulated Net Biospheric Production over the year
+    REAL(r_std), DIMENSION(npts), INTENT(out) :: nbp_flux  !! Net Biospheric Production over the year
+    !-
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(out) :: MatrixV
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: VectorU
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: previous_stock
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: current_stock    
+    REAL(r_std), DIMENSION(npts,nvm,npco2),   INTENT(out) :: assim_param
+
+    ! 0.4 local
+    !-
+    ! date, real
+    REAL(r_std) :: date_real
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
+    REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve), real
+    REAL(r_std),DIMENSION(npts,nvm) :: senescence_real
+    REAL(r_std),DIMENSION(npts,nvm) :: begin_leaves_real
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box? - real
+    REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
+    REAL(r_std), DIMENSION(1) :: vartmp  !! temporary variable because restget/restput needs an array and not a scalar
+    ! To store variables names for I/O
+    CHARACTER(LEN=80) :: var_name
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating litter type
+    CHARACTER(LEN=3),DIMENSION(nlitt) :: litter_str
+    ! 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=1),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    
+    ! land cover change variables 
+    ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
+    ! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std),DIMENSION(npts,0:10),INTENT(out)                           :: prod10
+    REAL(r_std),DIMENSION(npts,0:100),INTENT(out)                          :: prod100
+    ! annual release from the 10/100 year-turnover pool compartments
+    REAL(r_std),DIMENSION(npts,10),INTENT(out)                           :: flux10
+    REAL(r_std),DIMENSION(npts,100),INTENT(out)                          :: flux100
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: convflux
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod10
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod100
+    ! wood harvest variables 
+    ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
+    ! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std),DIMENSION(npts,0:10),INTENT(out)                           :: prod10_harvest
+    REAL(r_std),DIMENSION(npts,0:100),INTENT(out)                          :: prod100_harvest
+    ! annual release from the 10/100 year-turnover pool compartments
+    REAL(r_std),DIMENSION(npts,10),INTENT(out)                           :: flux10_harvest
+    REAL(r_std),DIMENSION(npts,100),INTENT(out)                          :: flux100_harvest
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: convflux_harvest
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod10_harvest
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod100_harvest
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                        :: convfluxpft
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                        :: fDeforestToProduct
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                        :: fLulccResidue
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                        :: fHarvestToProduct
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                        :: woodharvestpft
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out)         :: bm_to_litter
+    REAL(r_std),DIMENSION(npts),INTENT(out)                              :: carb_mass_total
+    REAL(r_std),DIMENSION(npts,nvm)                                      :: vcmax_tmp
+    !---------------------------------------------------------------------
+    IF (printlev >= 3) WRITE(numout,*) 'Entering readstart'
+    !-
+    ! 1 string definitions
+    !-
+    DO l=1,nlitt
+       IF     (l == imetabolic) THEN
+          litter_str(l) = 'met'
+       ELSEIF (l == istructural) THEN
+          litter_str(l) = 'str'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io readstart', 'Define litter_str','','')
+       ENDIF
+    ENDDO
+    !-
+    DO l=1,nlevs
+       IF     (l == iabove) THEN
+          level_str(l) = 'ab'
+       ELSEIF (l == ibelow) THEN
+          level_str(l) = 'be'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io readstart','Define level_str','','')
+       ENDIF
+    ENDDO
+
+    pools_str(1:nbpools) =(/'str_ab','str_be','met_ab','met_be','actif ','slow  ','passif'/)
+
+    !-
+    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_loc = NINT(date_real)
+    ENDIF
+    CALL bcast(date_loc)
+    !-
+    ! 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)
+    ! Keep val_exp as initial value for gdd_init_date(:,2)
+    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(:) = temp_air(:)
+    !-
+    tsoil_daily(:,:) = val_exp
+    var_name = 'tsoil_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nslm, 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,   nslm, 1, itime, &
+         &                .TRUE., soilhum_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(soilhum_daily(:,:) == val_exp)) soilhum_daily(:,:) = zero
+    !-
+    precip_daily(:) = val_exp
+    var_name = 'precip_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., precip_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_daily(:) == val_exp)) precip_daily(:) = zero
+    !-
+    ! 4 productivities
+    !-
+    gpp_daily(:,:) = val_exp
+    var_name = 'gpp_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gpp_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(gpp_daily(:,:) == val_exp)) gpp_daily(:,:) = zero
+    !-
+    npp_daily(:,:) = val_exp
+    var_name = 'npp_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., npp_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(npp_daily(:,:) == val_exp)) npp_daily(:,:) = zero
+    !-
+    turnover_daily(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                .TRUE., turnover_daily(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(turnover_daily(:,:,k,l) == val_exp)) &
+               &       turnover_daily(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    ! 5 monthly meteorological variables
+    !-
+    moiavail_month(:,:) = val_exp
+    var_name = 'moiavail_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_month, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_month(:,:) == val_exp)) moiavail_month(:,:) = zero
+    !-
+    moiavail_week(:,:) = val_exp
+    var_name = 'moiavail_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_week, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_week(:,:) == val_exp)) moiavail_week(:,:) = zero
+    
+
+    !
+    ! Longterm temperature at 2m
+    !
+    var_name = 't2m_longterm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_longterm, 'gather', nbp_glo, index_g)
+
+    IF (ALL(t2m_longterm(:) == val_exp)) THEN
+       ! t2m_longterm is not in restart file
+       ! The initial value for the reference temperature is set to the current temperature
+       t2m_longterm(:)=temp_air(:)
+       ! 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(:) = temp_air(:)
+    
+    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(:) = temp_air(:)
+    
+    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(:) = temp_air(:)
+    
+    tsoil_month(:,:) = val_exp
+    var_name = 'tsoil_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nslm, 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,nslm
+          tsoil_month(:,l) = temp_air(:)
+       ENDDO
+    ENDIF
+    !-
+    soilhum_month(:,:) = val_exp
+    var_name = 'soilhum_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nslm, 1, itime, &
+         &              .TRUE., soilhum_month, 'gather', nbp_glo, index_g)
+    IF (ALL(soilhum_month(:,:) == val_exp)) soilhum_month(:,:) = zero
+    !-
+    ! 6 fire probability
+    !-
+    fireindex(:,:) = val_exp
+    var_name = 'fireindex'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              .TRUE., fireindex, 'gather', nbp_glo, index_g)
+    IF (ALL(fireindex(:,:) == val_exp)) fireindex(:,:) = zero
+    !-
+    firelitter(:,:) = val_exp
+    var_name = 'firelitter'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              .TRUE., firelitter, 'gather', nbp_glo, index_g)
+    IF (ALL(firelitter(:,:) == val_exp)) firelitter(:,:) = zero
+    !-
+    ! 7 maximum and minimum moisture availabilities for tropic phenology
+    !-
+    maxmoiavail_lastyear(:,:) = val_exp
+    var_name = 'maxmoistr_last'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxmoiavail_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxmoiavail_lastyear(:,:) == val_exp)) &
+         &     maxmoiavail_lastyear(:,:) = zero
+    !-
+    maxmoiavail_thisyear(:,:) = val_exp
+    var_name = 'maxmoistr_this'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxmoiavail_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxmoiavail_thisyear(:,:) == val_exp)) &
+         &     maxmoiavail_thisyear(:,:) = zero
+    !-
+    minmoiavail_lastyear(:,:) = val_exp
+    var_name = 'minmoistr_last'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., minmoiavail_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(minmoiavail_lastyear(:,:) == val_exp)) &
+         &     minmoiavail_lastyear(:,:) = un
+    !-
+    minmoiavail_thisyear(:,:) = val_exp
+    var_name = 'minmoistr_this'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., minmoiavail_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL( minmoiavail_thisyear(:,:) == val_exp)) &
+         &     minmoiavail_thisyear(:,:) = un
+    !-
+    ! 8 maximum "weekly" GPP
+    !-
+    maxgppweek_lastyear(:,:) = val_exp
+    var_name = 'maxgppweek_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxgppweek_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxgppweek_lastyear(:,:) == val_exp)) &
+         &     maxgppweek_lastyear(:,:) = zero
+    !-
+    maxgppweek_thisyear(:,:) = val_exp
+    var_name = 'maxgppweek_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxgppweek_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxgppweek_thisyear(:,:) == val_exp)) &
+         &     maxgppweek_thisyear(:,:) = zero
+    !-
+    ! 9 annual GDD0
+    !-
+    gdd0_thisyear(:) = val_exp
+    var_name = 'gdd0_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., gdd0_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd0_thisyear(:) == val_exp)) gdd0_thisyear(:) = zero
+    !-
+    gdd0_lastyear(:) = val_exp
+    var_name = 'gdd0_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., gdd0_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd0_lastyear(:) == val_exp)) gdd0_lastyear(:) = gdd_crit_estab
+    !-
+    ! 10 annual precipitation
+    !-
+    precip_thisyear(:) = val_exp
+    var_name = 'precip_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., precip_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_thisyear(:) == val_exp)) precip_thisyear(:) = zero
+    !-
+    precip_lastyear(:) = val_exp
+    var_name = 'precip_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., precip_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_lastyear(:) == val_exp)) &
+         &     precip_lastyear(:) = precip_crit
+    !-
+    ! 11 derived "biometeorological" variables
+    !-
+    gdd_m5_dormance(:,:) = val_exp
+    var_name = 'gdd_m5_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_m5_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_m5_dormance(:,:) == val_exp)) &
+         &     gdd_m5_dormance(:,:) = undef
+    !-
+    gdd_from_growthinit(:,:) = val_exp
+    var_name = 'gdd_from_growthinit'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_from_growthinit, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_from_growthinit(:,:) == val_exp)) &
+         &     gdd_from_growthinit(:,:) = zero
+    !-
+    gdd_midwinter(:,:) = val_exp
+    var_name = 'gdd_midwinter'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_midwinter, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_midwinter(:,:) == val_exp)) gdd_midwinter(:,:) = undef
+    !-
+    ncd_dormance(:,:) = val_exp
+    var_name = 'ncd_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ncd_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(ncd_dormance(:,:) == val_exp)) ncd_dormance(:,:) = undef
+    !-
+    ngd_minus5(:,:) = val_exp
+    var_name = 'ngd_minus5'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ngd_minus5, 'gather', nbp_glo, index_g)
+    IF (ALL(ngd_minus5(:,:) == val_exp)) ngd_minus5(:,:) = zero
+    !-
+    time_hum_min(:,:) = val_exp
+    var_name = 'time_hum_min'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., time_hum_min, 'gather', nbp_glo, index_g)
+    IF (ALL(time_hum_min(:,:) == val_exp)) time_hum_min(:,:) = undef
+    !-
+    hum_min_dormance(:,:) = val_exp
+    var_name = 'hum_min_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., hum_min_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(hum_min_dormance(:,:) == val_exp)) &
+         &     hum_min_dormance(:,:) = undef
+    !-
+    ! 12 Plant status
+    !-
+    PFTpresent_real(:,:) = val_exp
+    var_name = 'PFTpresent'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., PFTpresent_real, 'gather', nbp_glo, index_g)
+    IF (ALL(PFTpresent_real(:,:) == val_exp)) PFTpresent_real(:,:) = zero
+    WHERE (PFTpresent_real(:,:) >= .5)
+       PFTpresent = .TRUE.
+    ELSEWHERE
+       PFTpresent = .FALSE.
+    ENDWHERE
+    !-
+    ind(:,:) = val_exp
+    var_name = 'ind'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ind, 'gather', nbp_glo, index_g)
+    IF (ALL(ind(:,:) == val_exp)) ind(:,:) = zero
+    !-
+    adapted(:,:) = val_exp
+    var_name = 'adapted'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., adapted, 'gather', nbp_glo, index_g)
+    IF (ALL(adapted(:,:) == val_exp)) adapted(:,:) = zero
+    !-
+    regenerate(:,:) = val_exp
+    var_name = 'regenerate'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., regenerate, 'gather', nbp_glo, index_g)
+    IF (ALL(regenerate(:,:) == val_exp)) regenerate(:,:) = zero
+    !-
+    npp_longterm(:,:) = val_exp
+    var_name = 'npp_longterm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., npp_longterm, 'gather', nbp_glo, index_g)
+    IF (ALL(npp_longterm(:,:) == val_exp)) npp_longterm(:,:) = zero
+    !-
+    lm_lastyearmax(:,:) = val_exp
+    var_name = 'lm_lastyearmax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., lm_lastyearmax, 'gather', nbp_glo, index_g)
+    IF (ALL(lm_lastyearmax(:,:) == val_exp)) lm_lastyearmax(:,:) = zero
+    !-
+    lm_thisyearmax(:,:) = val_exp
+    var_name = 'lm_thisyearmax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., lm_thisyearmax, 'gather', nbp_glo, index_g)
+    IF (ALL(lm_thisyearmax(:,:) == val_exp)) lm_thisyearmax(:,:) = zero
+    !-
+    maxfpc_lastyear(:,:) = val_exp
+    var_name = 'maxfpc_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxfpc_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxfpc_lastyear(:,:) == val_exp)) maxfpc_lastyear(:,:) = zero
+    !-
+    maxfpc_thisyear(:,:) = val_exp
+    var_name = 'maxfpc_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxfpc_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxfpc_thisyear(:,:) == val_exp)) maxfpc_thisyear(:,:) = zero
+    !-
+    turnover_time(:,:) = val_exp
+    var_name = 'turnover_time'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., turnover_time, 'gather', nbp_glo, index_g)
+    IF ( ALL( turnover_time(:,:) == val_exp)) turnover_time(:,:) = 100.
+    !-
+    turnover_longterm(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'turnover_longterm_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &              .TRUE., turnover_longterm(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(turnover_longterm(:,:,k,l) == val_exp)) &
+               &       turnover_longterm(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    gpp_week(:,:) = val_exp
+    var_name = 'gpp_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gpp_week, 'gather', nbp_glo, index_g)
+    IF (ALL(gpp_week(:,:) == val_exp)) gpp_week(:,:) = zero
+    !-
+    biomass(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                   .TRUE., biomass(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(biomass(:,:,k,l) == val_exp)) biomass(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    resp_maint_part(:,:,:) = val_exp
+    DO k=1,nparts
+       WRITE(part_str,'(I2)') k
+       IF ( k < 10 ) part_str(1:1) = '0'
+       var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., resp_maint_part(:,:,k), 'gather', nbp_glo, index_g)
+       IF (ALL(resp_maint_part(:,:,k) == val_exp)) resp_maint_part(:,:,k) = zero
+    ENDDO
+    !-
+    leaf_age(:,:,:) = val_exp
+    DO m=1,nleafages
+       WRITE (part_str,'(I2)') m
+       IF ( m < 10 ) part_str(1:1) = '0'
+       var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., leaf_age(:,:,m), 'gather', nbp_glo, index_g)
+       IF (ALL(leaf_age(:,:,m) == val_exp)) leaf_age(:,:,m) = zero
+    ENDDO
+    !-
+    leaf_frac(:,:,:) = val_exp
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF ( m < 10 ) part_str(1:1) = '0'
+       var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                  .TRUE., leaf_frac(:,:,m), 'gather', nbp_glo, index_g)
+       IF (ALL(leaf_frac(:,:,m) == val_exp)) leaf_frac(:,:,m) = zero
+    ENDDO
+    !-
+    senescence_real(:,:) = val_exp
+    var_name = 'senescence'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., senescence_real, 'gather', nbp_glo, index_g)
+    IF (ALL(senescence_real(:,:) == val_exp)) senescence_real(:,:) = zero
+    WHERE ( senescence_real(:,:) >= .5 )
+       senescence = .TRUE.
+    ELSEWHERE
+       senescence = .FALSE.
+    ENDWHERE
+
+
+    ! Read real value for begin_leaves
+    CALL restget_p (rest_id_stomate, 'begin_leaves', nbp_glo, nvm  , 1, itime, &
+         .TRUE., begin_leaves_real, 'gather', nbp_glo, index_g)
+    IF (ALL(begin_leaves_real(:,:) == val_exp)) begin_leaves_real(:,:) = zero
+
+    ! Transform into logical needed by the modele
+    WHERE ( begin_leaves_real(:,:) >= 0.5 )
+       begin_leaves = .TRUE.
+    ELSEWHERE
+       begin_leaves = .FALSE.
+    ENDWHERE
+
+
+    when_growthinit(:,:) = val_exp
+    var_name = 'when_growthinit'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., when_growthinit, 'gather', nbp_glo, index_g)
+    IF (ALL(when_growthinit(:,:) == val_exp)) &
+         &     when_growthinit(:,:) = zero
+    !-
+    age(:,:) = val_exp
+    var_name = 'age'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., age, 'gather', nbp_glo, index_g)
+    IF (ALL(age(:,:) == val_exp)) age(:,:) = zero
+    !-
+    ! 13 CO2
+    !-
+    resp_hetero(:,:) = val_exp
+    var_name = 'resp_hetero'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                .TRUE., resp_hetero, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_hetero(:,:) == val_exp)) resp_hetero(:,:) = zero
+    !-
+    resp_maint(:,:) = val_exp
+    var_name = 'resp_maint'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., resp_maint, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_maint(:,:) == val_exp)) resp_maint(:,:) = zero
+    !-
+    resp_growth(:,:) = val_exp
+    var_name = 'resp_growth'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., resp_growth, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_growth(:,:) == val_exp)) resp_growth(:,:) = zero
+    !-
+    co2_fire(:,:) = val_exp
+    var_name = 'co2_fire'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &                .TRUE., co2_fire, 'gather', nbp_glo, index_g)
+    IF (ALL(co2_fire(:,:) == val_exp)) co2_fire(:,:) = zero
+    !-
+    co2_to_bm_dgvm(:,:) = val_exp
+    var_name = 'co2_to_bm_dgvm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &                .TRUE., co2_to_bm_dgvm, 'gather', nbp_glo, index_g)
+    IF (ALL(co2_to_bm_dgvm(:,:) == val_exp)) co2_to_bm_dgvm(:,:) = zero
+
+    co2_to_bm_radia(:,:) = val_exp
+    var_name = 'co2_to_bm_radia'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &                .TRUE., co2_to_bm_radia, 'gather', nbp_glo, index_g)
+    IF (ALL(co2_to_bm_radia(:,:) == val_exp)) co2_to_bm_radia(:,:) = zero
+    !-
+    ! 14 vegetation distribution after last light competition
+    !-
+    veget_lastlight(:,:) = val_exp
+    var_name = 'veget_lastlight'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., veget_lastlight, 'gather', nbp_glo, index_g)
+    IF (ALL(veget_lastlight(:,:) == val_exp)) veget_lastlight(:,:) = zero
+    !-
+    ! 15 establishment criteria
+    !-
+    everywhere(:,:) = val_exp
+    var_name = 'everywhere'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., everywhere, 'gather', nbp_glo, index_g)
+    IF (ALL(everywhere(:,:) == val_exp)) everywhere(:,:) = zero
+    !-
+    need_adjacent_real(:,:) = val_exp
+    var_name = 'need_adjacent'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., need_adjacent_real, 'gather', nbp_glo, index_g)
+    IF (ALL(need_adjacent_real(:,:) == val_exp)) &
+         &     need_adjacent_real(:,:) = zero
+    WHERE ( need_adjacent_real(:,:) >= .5 )
+       need_adjacent = .TRUE.
+    ELSEWHERE
+       need_adjacent = .FALSE.
+    ENDWHERE
+    !-
+    RIP_time(:,:) = val_exp
+    var_name = 'RIP_time'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., RIP_time, 'gather', nbp_glo, index_g)
+    IF (ALL(RIP_time(:,:) == val_exp)) RIP_time(:,:) = large_value
+    !-
+    ! 17 litter
+    !-
+    litterpart(:,:,:) = val_exp
+    DO l=1,nlitt
+       var_name = 'litterpart_'//litter_str(l)
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., litterpart(:,:,l), 'gather', nbp_glo, index_g)
+       IF (ALL(litterpart(:,:,l) == val_exp)) litterpart(:,:,l) = zero
+    ENDDO
+    !-
+    litter(:,:,:,:,:) = val_exp
+    DO k = 1,nelements
+       DO l = 1,nlevs
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_'//level_str(l)//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter(:,:,m,l,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter(:,:,m,l,k) == val_exp)) litter(:,:,m,l,k) = zero
+          ENDDO
+       ENDDO
+    END DO
+    !-
+    dead_leaves(:,:,:) = val_exp
+    DO l=1,nlitt
+       var_name = 'dead_leaves_'//litter_str(l)
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., dead_leaves(:,:,l), 'gather', nbp_glo, index_g)
+       IF (ALL(dead_leaves(:,:,l) == val_exp)) dead_leaves(:,:,l) = zero
+    ENDDO
+    !-
+    carbon(:,:,:) = val_exp
+    DO m=1,nvm
+       WRITE (part_str, '(I2)') m
+       IF (m<10) part_str(1:1)='0'
+       var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+            &                   .TRUE., carbon(:,:,m), 'gather', nbp_glo, index_g)
+       IF (ALL(carbon(:,:,m) == val_exp)) carbon(:,:,m) = zero
+    ENDDO
+    !-
+    lignin_struc(:,:,:) = val_exp
+    DO l=1,nlevs
+       var_name = 'lignin_struc_'//level_str(l)
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc(:,:,l), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc(:,:,l) == val_exp)) lignin_struc(:,:,l) = zero
+    ENDDO
+
+
+    !-
+    ! 18 land cover change
+    !-
+    IF (vegetmap_reset) THEN
+       ! Reset vegetation map related variables instead of reading from restart file
+       prod10(:,:) = zero
+       prod100(:,:) = zero
+       flux10(:,:) = zero
+       flux100(:,:) = zero
+       convflux(:) = zero
+       cflux_prod10(:) = zero
+       cflux_prod100(:) = zero
+       convfluxpft(:,:) = zero
+
+    ELSE
+       ! Read from restart file or set to zero if the variables or restart file were not found
+       prod10(:,:) = val_exp
+       var_name = 'prod10'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 11     , 1, itime, &
+            .TRUE., prod10, 'gather', nbp_glo, index_g)
+       IF (ALL(prod10(:,:) == val_exp)) prod10(:,:) = zero
+       
+       prod100(:,:) = val_exp
+       var_name = 'prod100'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 101     , 1, itime, &
+            .TRUE., prod100, 'gather', nbp_glo, index_g)
+       IF (ALL(prod100(:,:) == val_exp)) prod100(:,:) = zero
+              
+       flux10(:,:) = val_exp
+       var_name = 'flux10'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 10     , 1, itime, &
+            .TRUE., flux10, 'gather', nbp_glo, index_g)
+       IF (ALL(flux10(:,:) == val_exp)) flux10(:,:) = zero
+       
+       flux100(:,:) = val_exp
+       var_name = 'flux100'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 100     , 1, itime, &
+            .TRUE., flux100, 'gather', nbp_glo, index_g)
+       IF (ALL(flux100(:,:) == val_exp)) flux100(:,:) = zero
+       
+       convflux(:) = val_exp
+       var_name = 'convflux'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            .TRUE., convflux, 'gather', nbp_glo, index_g)
+       IF (ALL(convflux(:) == val_exp)) convflux(:) = zero
+       
+       cflux_prod10(:) = val_exp
+       var_name = 'cflux_prod10'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            .TRUE., cflux_prod10, 'gather', nbp_glo, index_g)
+       IF (ALL(cflux_prod10(:) == val_exp)) cflux_prod10(:) = zero
+       
+       cflux_prod100(:) = val_exp
+       var_name = 'cflux_prod100'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            .TRUE., cflux_prod100, 'gather', nbp_glo, index_g)
+       IF (ALL(cflux_prod100(:) == val_exp)) cflux_prod100(:) = zero
+       
+       convfluxpft(:,:) = val_exp
+       var_name = 'convfluxpft'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            .TRUE., convfluxpft, 'gather', nbp_glo, index_g)
+       IF (ALL(convfluxpft(:,:) == val_exp)) convfluxpft(:,:) = zero
+    END IF
+
+    fDeforestToProduct(:,:) = val_exp
+    var_name = 'fDeforestToProduct'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &   .TRUE., fDeforestToProduct, 'gather', nbp_glo, index_g)
+    IF (ALL(fDeforestToProduct(:,:) ==val_exp)) fDeforestToProduct(:,:) = zero
+
+    fLulccResidue(:,:) = val_exp
+    var_name = 'fLulccResidue'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &   .TRUE., fLulccResidue, 'gather', nbp_glo, index_g)
+    IF (ALL(fLulccResidue(:,:) ==val_exp)) fLulccResidue(:,:) = zero
+
+    fHarvestToProduct(:,:) = val_exp
+    var_name = 'fHarvestToProduct'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &   .TRUE., fHarvestToProduct, 'gather', nbp_glo, index_g)
+    IF (ALL(fHarvestToProduct(:,:) ==val_exp)) fHarvestToProduct(:,:) = zero
+
+    !-
+    ! 18-bis wood harvest
+    !-
+    IF (do_wood_harvest) THEN
+       prod10_harvest(:,:) = val_exp
+       var_name = 'prod10_harvest'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 11     , 1, itime, &
+            .TRUE., prod10_harvest, 'gather', nbp_glo, index_g)
+       IF (ALL(prod10_harvest(:,:) == val_exp)) prod10_harvest(:,:) = zero
+       
+       prod100_harvest(:,:) = val_exp
+       var_name = 'prod100_harvest'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 101     , 1, itime, &
+            .TRUE., prod100_harvest, 'gather', nbp_glo, index_g)
+       IF (ALL(prod100_harvest(:,:) == val_exp)) prod100_harvest(:,:) = zero
+       
+       flux10_harvest(:,:) = val_exp
+       var_name = 'flux10_harvest'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 10     , 1, itime, &
+            .TRUE., flux10_harvest, 'gather', nbp_glo, index_g)
+       IF (ALL(flux10_harvest(:,:) == val_exp)) flux10_harvest(:,:) = zero
+       
+       flux100_harvest(:,:) = val_exp
+       var_name = 'flux100_harvest'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 100     , 1, itime, &
+            .TRUE., flux100_harvest, 'gather', nbp_glo, index_g)
+       IF (ALL(flux100_harvest(:,:) == val_exp)) flux100_harvest(:,:) = zero
+       
+       convflux_harvest(:) = val_exp
+       var_name = 'convflux_harvest'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            .TRUE., convflux_harvest, 'gather', nbp_glo, index_g)
+       IF (ALL(convflux_harvest(:) == val_exp)) convflux_harvest(:) = zero
+       
+       cflux_prod10_harvest(:) = val_exp
+       var_name = 'cflux_prod10_harvest'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            .TRUE., cflux_prod10_harvest, 'gather', nbp_glo, index_g)
+       IF (ALL(cflux_prod10_harvest(:) == val_exp)) cflux_prod10_harvest(:) = zero
+       
+       cflux_prod100_harvest(:) = val_exp
+       var_name = 'cfluxprod100_harvest'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            .TRUE., cflux_prod100_harvest, 'gather', nbp_glo, index_g)
+       IF (ALL(cflux_prod100_harvest(:) == val_exp)) cflux_prod100_harvest(:) = zero
+       
+       woodharvestpft(:,:) = val_exp
+       var_name = 'woodharvestpft'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            .TRUE., woodharvestpft, 'gather', nbp_glo, index_g)
+       IF (ALL(woodharvestpft(:,:) == val_exp)) woodharvestpft(:,:) = zero
+    END IF
+
+
+    bm_to_litter(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                .TRUE., bm_to_litter(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(bm_to_litter(:,:,k,l) == val_exp)) bm_to_litter(:,:,k,l) = zero
+       ENDDO
+    END DO
+
+    carb_mass_total(:) = val_exp
+    var_name = 'carb_mass_total'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., carb_mass_total, 'gather', nbp_glo, index_g)
+    IF (ALL(carb_mass_total(:) == val_exp)) carb_mass_total(:) = zero
+    !-
+    ! 19. Spinup
+    !-
+    IF (spinup_analytic) THEN
+
+       IF (is_root_prc) THEN
+          temp_global_years(1) = val_exp
+          var_name = 'Global_years'
+          CALL restget (rest_id_stomate, var_name, 1 ,1  , 1, itime, &
+               &                .TRUE., temp_global_years)
+          IF(temp_global_years(1) == val_exp) temp_global_years(1) = zero
+          global_years = INT(temp_global_years(1))
+       ENDIF
+       CALL bcast(global_years)
+
+       nbp_accu(:) = val_exp
+       var_name = 'nbp_sum'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            &              .TRUE., nbp_accu, 'gather', nbp_glo, index_g)
+       IF (ALL(nbp_accu(:) == val_exp)) nbp_accu(:) = zero    
+
+       nbp_flux(:) = val_exp
+       var_name = 'nbp_flux'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            &              .TRUE., nbp_flux, 'gather', nbp_glo, index_g)
+       IF (ALL(nbp_flux(:) == val_exp)) nbp_flux(:) = zero     
+
+       !-
+       ok_equilibrium_real(:) = val_exp
+       var_name = 'ok_equilibrium'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo , 1  , 1, itime, &
+            &                .TRUE., ok_equilibrium_real,'gather', nbp_glo, index_g)
+       IF (ALL(ok_equilibrium_real(:) == val_exp)) ok_equilibrium_real(:) = zero
+       WHERE(ok_equilibrium_real(:) >= 0.5) 
+          ok_equilibrium = .TRUE.
+       ELSEWHERE
+          ok_equilibrium = .FALSE.
+       ENDWHERE
+
+       MatrixV(:,:,:,:) = val_exp
+       DO k = 1,nbpools
+          DO j = 1,nbpools
+             WRITE(part_str,'(I2)') k
+             IF (k < 10) part_str(1:1) = '0'             
+             var_name = '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
+ 
+         
+    ENDIF ! spinup_matrix_method
+
+
+    ! Read assim_param from restart file. The initialization of assim_param will 
+    ! be done in stomate_var_init if the variable is not in the restart file.
+    assim_param(:,:,:)  = val_exp
+    DO k= 1,npco2
+       WRITE(part_str,'(I2)') k
+       IF (k < 10) part_str(1:1) = '0' 
+       var_name = 'assim_param_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., assim_param(:,:,k), 'gather', nbp_glo, index_g)
+    END DO
+ 
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving readstart'
+    !-----------------------
+  END SUBROUTINE readstart
+
+!! ================================================================================================================================
+!! SUBROUTINE   : writerestart
+!!
+!>\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_loc, &
+       &  ind, adapted, regenerate, moiavail_daily, gdd_init_date, litterhum_daily, &
+       &  t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+       &  soilhum_daily, precip_daily, gpp_daily, npp_daily, &
+       &  turnover_daily, moiavail_month, moiavail_week, &
+       &  t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+       &  tsoil_month, soilhum_month, fireindex, firelitter, &
+       &  maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       &  minmoiavail_lastyear, minmoiavail_thisyear, &
+       &  maxgppweek_lastyear, maxgppweek_thisyear, &
+       &  gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
+       &  gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       &  PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+       &  maxfpc_lastyear, maxfpc_thisyear, &
+       &  turnover_longterm, gpp_week, biomass, resp_maint_part, &
+       &  leaf_age, leaf_frac, senescence, when_growthinit, age, &
+       &  resp_hetero, resp_maint, resp_growth, co2_fire, co2_to_bm_dgvm, co2_to_bm_radia, &
+       &  veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       &  time_hum_min, hum_min_dormance, &
+       &  litterpart, litter, dead_leaves, &
+       &  carbon, lignin_struc, turnover_time, &
+       &  prod10,prod100 ,flux10, flux100, &
+       &  convflux, cflux_prod10, cflux_prod100, & 
+       &  prod10_harvest,prod100_harvest ,flux10_harvest, flux100_harvest, &
+       &  convflux_harvest, cflux_prod10_harvest, cflux_prod100_harvest, &
+       &  convfluxpft, fDeforestToProduct, fLulccResidue, fHarvestToProduct, &
+       &  woodharvestpft, bm_to_litter, carb_mass_total, &
+       &  Tseason, Tseason_length, Tseason_tmp, & 
+       &  Tmin_spring_time, begin_leaves, onset_date, &
+       &  global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+       &  MatrixV, VectorU, previous_stock, current_stock, assim_param)
+
+    !---------------------------------------------------------------------
+    !- write restart file
+    !---------------------------------------------------------------------
+    !-
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+    INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
+    ! time step of STOMATE in days
+    REAL(r_std),INTENT(in) :: dt_days
+    ! date_loc (d)
+    INTEGER(i_std),INTENT(in) :: date_loc
+    ! density of individuals (1/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ind
+    ! Winter too cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: adapted
+    ! Winter sufficiently cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: regenerate
+    ! daily moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_daily
+    ! gdd init date
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: gdd_init_date
+    ! daily litter humidity
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: litterhum_daily
+    ! daily 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_daily
+    ! daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_min_daily
+    ! daily surface temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: tsurf_daily
+    ! daily soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nslm),INTENT(in) :: tsoil_daily
+    ! daily soil humidity
+    REAL(r_std),DIMENSION(npts,nslm),INTENT(in) :: soilhum_daily
+    ! daily precipitations (mm/day) (for phenology)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_daily
+    ! daily gross primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_daily
+    ! daily net primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_daily
+    ! daily turnover rates (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: turnover_daily
+    ! "monthly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_month
+    ! "weekly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_week
+    ! "long term" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_longterm
+    ! "tau_longterm"
+    REAL(r_std), INTENT(IN)             :: tau_longterm
+    ! "monthly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_month
+    ! "seasonal" 2 meter temperatures (K) 
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason_length
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason_tmp
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)  :: Tmin_spring_time
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)  :: onset_date
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in)      :: begin_leaves
+
+    ! "weekly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_week
+    ! "monthly" soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nslm),INTENT(in) :: tsoil_month
+    ! "monthly" soil humidity
+    REAL(r_std),DIMENSION(npts,nslm),INTENT(in) :: soilhum_month
+    ! Probability of fire
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: fireindex
+    ! Longer term total litter above the ground, gC/m**2 of ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: firelitter
+    ! last year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_lastyear
+    ! this year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_thisyear
+    ! last year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_lastyear
+    ! this year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_thisyear
+    ! last year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_lastyear
+    ! this year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_thisyear
+    ! last year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_lastyear
+    ! this year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_thisyear
+    ! last year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_lastyear
+    ! this year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_thisyear
+    ! growing degree days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_m5_dormance
+    ! growing degree days, from begin of season (crops)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_from_growthinit
+    ! growing degree days since midwinter (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_midwinter
+    ! number of chilling days since leaves were lost (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ncd_dormance
+    ! number of growing days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ngd_minus5
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: PFTpresent
+    ! "long term" net primary productivity (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_longterm
+    ! last year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_lastyearmax
+    ! this year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_thisyearmax
+    ! last year's maximum fpc for each natural PFT, on ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_lastyear
+    ! this year's maximum fpc for each PFT,
+    ! on *total* ground (see stomate_season)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_thisyear
+    ! "long term" turnover rate (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: turnover_longterm
+    ! "weekly" GPP (gC/day/(m**2 covered)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_week
+    ! biomass (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass
+    ! maintenance respiration (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: resp_maint_part
+    ! leaf age (days)
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(in) :: leaf_age
+    ! fraction of leaves in leaf age class
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(in) :: leaf_frac
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: senescence
+    ! how many days ago was the beginning of the growing season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: when_growthinit
+    ! mean age (years)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: age
+    ! heterotrophic respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_hetero
+    ! maintenance respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_maint
+    ! growth respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_growth
+    ! carbon emitted into the atmosphere by fire (living and dead biomass)
+    ! (in gC/m**2/time step)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_fire
+    ! biomass uptaken (gC/(m**2 of total ground)/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_to_bm_dgvm
+    ! biomass uptaken (gC/(m**2 of total ground)/dt_sechiba)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_to_bm_radia
+    ! vegetation fractions (on ground) after last light competition
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: veget_lastlight
+    ! is the PFT everywhere in the grid box or very localized
+    ! (after its introduction)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: everywhere
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box?
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: need_adjacent
+    ! How much time ago was the PFT eliminated for the last time (y)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: RIP_time
+    ! time elapsed since strongest moisture availability (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: time_hum_min
+    ! minimum moisture during dormance
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: hum_min_dormance
+    ! fraction of litter above the ground belonging to different PFTs
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(in) :: litterpart
+    ! metabolic and structural litter, above and below ground (gC/m**2)
+    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
+    ! carbon pool: active, slow, or passive, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,ncarb,nvm),INTENT(in) :: carbon
+    ! ratio Lignine/Carbon in structural litter, above and below ground, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(in) :: lignin_struc
+    ! turnover_time of leaves
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: turnover_time
+
+    ! For Spinup matrix resolution
+    INTEGER(i_std), INTENT(in) :: global_years   
+    LOGICAL, DIMENSION(npts), INTENT(in) :: ok_equilibrium
+    REAL(r_std), DIMENSION(npts), INTENT(in) :: nbp_accu  !! Accumulated Net Biospheric Production over the year 
+    REAL(r_std), DIMENSION(npts), INTENT(in) :: nbp_flux  !! Net Biospheric Production over the year 
+    !-
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(in) :: MatrixV
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: VectorU
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: previous_stock
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: current_stock 
+    REAL(r_std), DIMENSION(npts,nvm,npco2),   INTENT(in) :: assim_param
+    !-
+    ! 0.2 local
+    !-
+    ! date, real
+    REAL(r_std) :: date_real
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
+    REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve), real
+    REAL(r_std),DIMENSION(npts,nvm) :: senescence_real
+    REAL(r_std),DIMENSION(npts,nvm) :: begin_leaves_real
+
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box? - real
+    REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
+    ! To store variables names for I/O
+    CHARACTER(LEN=80) :: var_name
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating litter type
+    CHARACTER(LEN=3),DIMENSION(nlitt) :: litter_str
+    ! string suffix indicating level
+    CHARACTER(LEN=2),DIMENSION(nlevs) :: level_str
+    ! temporary storage
+    REAL(r_std),DIMENSION(1) :: xtmp
+    REAL(r_std), DIMENSION(1) :: vartmp  !! temporary variable because restget/restput needs a variable with DIMESION(:)
+    ! index
+    INTEGER(i_std) :: j,k,l,m
+    CHARACTER(LEN=1),DIMENSION(nelements) :: element_str  !! string suffix indicating element
+    REAL(r_std), DIMENSION(1) :: temp_global_years
+    CHARACTER(LEN=6),DIMENSION(nbpools) :: pools_str
+    REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real    
+
+    ! land cover change variables 
+    ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
+    ! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std),DIMENSION(npts,0:10),INTENT(in)                           :: prod10
+    REAL(r_std),DIMENSION(npts,0:100),INTENT(in)                          :: prod100
+    ! annual release from the 10/100 year-turnover pool compartments
+    REAL(r_std),DIMENSION(npts,10),INTENT(in)                           :: flux10
+    REAL(r_std),DIMENSION(npts,100),INTENT(in)                          :: flux100
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: convflux
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod10
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod100
+
+    ! wood harvest variables 
+    ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
+    ! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std),DIMENSION(npts,0:10),INTENT(in)                           :: prod10_harvest
+    REAL(r_std),DIMENSION(npts,0:100),INTENT(in)                          :: prod100_harvest
+    ! annual release from the 10/100 year-turnover pool compartments
+    REAL(r_std),DIMENSION(npts,10),INTENT(in)                           :: flux10_harvest
+    REAL(r_std),DIMENSION(npts,100),INTENT(in)                          :: flux100_harvest
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: convflux_harvest
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod10_harvest
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod100_harvest
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: convfluxpft
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: fDeforestToProduct
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: fLulccResidue
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: fHarvestToProduct
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: woodharvestpft
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in)         :: bm_to_litter
+    REAL(r_std),DIMENSION(npts),INTENT(in)                              :: carb_mass_total
+    !---------------------------------------------------------------------
+    IF (printlev >= 3) WRITE(numout,*) 'Entering writerestart'
+    !-
+    ! 1 string definitions
+    !-
+    DO l=1,nlitt
+       IF     (l == imetabolic) THEN
+          litter_str(l) = 'met'
+       ELSEIF (l == istructural) THEN
+          litter_str(l) = 'str'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io writerestart','Define litter_str','','')
+       ENDIF
+    ENDDO
+    !-
+    DO l=1,nlevs
+       IF     (l == iabove) THEN
+          level_str(l) = 'ab'
+       ELSEIF (l == ibelow) THEN
+          level_str(l) = 'be'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io writerestart','Define level_str','','')
+       ENDIF
+    ENDDO
+    !-
+    DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = ''
+!!$       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','actif ','slow  ','passif'/)
+    !-
+    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_loc,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, nslm, 1, itime, &
+         &                tsoil_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soilhum_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nslm, 1, itime, &
+         &                soilhum_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'precip_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                precip_daily, 'scatter', nbp_glo, index_g)
+    !-
+    ! 4 productivities
+    !-
+    var_name = 'gpp_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gpp_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'npp_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                npp_daily, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   turnover_daily(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    ! 5 monthly meteorological variables
+    !-
+    var_name = 'moiavail_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_month, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'moiavail_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_week, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_longterm, 'scatter', nbp_glo, index_g)
+    
+    IF (is_root_prc) THEN
+       var_name='tau_longterm'
+       vartmp(1)=tau_longterm
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, vartmp)
+    ENDIF
+       
+
+    var_name = 't2m_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+                         t2m_month, 'scatter', nbp_glo, index_g)
+    
+
+    CALL restput_p (rest_id_stomate, 'Tseason', nbp_glo,    1, 1, itime, &
+         Tseason, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tseason_length', nbp_glo,    1, 1, itime, &
+         Tseason_length, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tseason_tmp', nbp_glo,    1, 1, itime, &
+         Tseason_tmp, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tmin_spring_time', nbp_glo, nvm, 1, itime, &
+         Tmin_spring_time, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'onset_date', nbp_glo, nvm, 1, itime, &
+         onset_date(:,:), 'scatter', nbp_glo, index_g)
+    
+    var_name = 't2m_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_week, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsoil_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nslm, 1, itime, &
+         &                tsoil_month, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soilhum_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nslm, 1, itime, &
+         &                soilhum_month, 'scatter', nbp_glo, index_g)
+    !-
+    ! 6 fire probability
+    !-
+    var_name = 'fireindex'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                fireindex, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'firelitter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                firelitter, 'scatter', nbp_glo, index_g)
+    !-
+    ! 7 maximum and minimum moisture availabilities for tropic phenology
+    !-
+    var_name = 'maxmoistr_last'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxmoiavail_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxmoistr_this'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxmoiavail_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'minmoistr_last'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                minmoiavail_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'minmoistr_this'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                minmoiavail_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 8 maximum "weekly" GPP
+    !-
+    var_name = 'maxgppweek_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxgppweek_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxgppweek_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxgppweek_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 9 annual GDD0
+    !-
+    var_name = 'gdd0_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                gdd0_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd0_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                gdd0_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 10 annual precipitation
+    !-
+    var_name = 'precip_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                precip_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'precip_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                precip_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 11 derived "biometeorological" variables
+    !-
+    var_name = 'gdd_m5_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gdd_m5_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_from_growthinit'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              gdd_from_growthinit, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_midwinter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gdd_midwinter, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ncd_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ncd_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ngd_minus5'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ngd_minus5, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'time_hum_min'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                time_hum_min, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'hum_min_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                hum_min_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    ! 12 Plant status
+    !-
+    var_name = 'PFTpresent'
+    WHERE ( PFTpresent(:,:) )
+       PFTpresent_real = un
+    ELSEWHERE
+       PFTpresent_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                PFTpresent_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ind'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ind, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'turnover_time'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                turnover_time, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'adapted'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                adapted, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'regenerate'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                regenerate, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'npp_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                npp_longterm, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lm_lastyearmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                lm_lastyearmax, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lm_thisyearmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                lm_thisyearmax, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxfpc_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxfpc_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxfpc_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxfpc_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_longterm_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   turnover_longterm(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    var_name = 'gpp_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gpp_week, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   biomass(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    DO k=1,nparts
+       WRITE(part_str,'(I2)') k
+       IF (k < 10) part_str(1:1) = '0'
+       var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   resp_maint_part(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF (m < 10) part_str(1:1) = '0'
+       var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                  leaf_age(:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF (m < 10) part_str(1:1) = '0'
+       var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   leaf_frac(:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    var_name = 'senescence'
+    WHERE ( senescence(:,:) )
+       senescence_real = un
+    ELSEWHERE
+       senescence_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                senescence_real, 'scatter', nbp_glo, index_g)
+ 
+    ! Transform the logical variable begin_leaves to real before writing to restart file
+    WHERE ( begin_leaves(:,:) )
+       begin_leaves_real = un
+    ELSEWHERE
+       begin_leaves_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, 'begin_leaves', nbp_glo, nvm, 1, itime, &
+         begin_leaves_real, 'scatter', nbp_glo, index_g)
+
+
+    var_name = 'when_growthinit'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                when_growthinit, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'age'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                age, 'scatter', nbp_glo, index_g)
+    !-
+    ! 13 CO2
+    !-
+    var_name = 'resp_hetero'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_hetero, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'resp_maint'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_maint, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'resp_growth'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_growth, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'co2_fire'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+         &                co2_fire, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'co2_to_bm_dgvm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                co2_to_bm_dgvm, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'co2_to_bm_radia'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                co2_to_bm_radia, 'scatter', nbp_glo, index_g)
+    !-
+    ! 14 vegetation distribution after last light competition
+    !-
+    var_name = 'veget_lastlight'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                veget_lastlight, 'scatter', nbp_glo, index_g)
+    !-
+    ! 15 establishment criteria
+    !-
+    var_name = 'everywhere'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                everywhere, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'need_adjacent'
+    WHERE (need_adjacent(:,:))
+       need_adjacent_real = un
+    ELSEWHERE
+       need_adjacent_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                need_adjacent_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'RIP_time'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                RIP_time, 'scatter', nbp_glo, index_g)
+    !-
+    ! 17 litter
+    !-
+    DO l=1,nlitt
+       var_name = 'litterpart_'//litter_str(l)
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+            &                   litterpart(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO k = 1,nelements
+       DO l = 1,nlevs
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_'//level_str(l)//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter(:,:,m,l,k), 'scatter', nbp_glo, index_g)
+          ENDDO
+       ENDDO
+    END DO
+    !-
+    DO l=1,nlitt
+       var_name = 'dead_leaves_'//litter_str(l)
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+            &                   dead_leaves(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nvm
+       WRITE (part_str, '(I2)') m
+       IF (m<10) part_str(1:1)='0'
+       var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+            &                   carbon(:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO l=1,nlevs
+       var_name = 'lignin_struc_'//level_str(l)
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    ! 18 land cover change
+    !-
+    var_name = 'prod10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 11, 1, itime, &
+         &                prod10, 'scatter', nbp_glo, index_g)
+    var_name = 'prod100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 101, 1, itime, &
+         &                prod100, 'scatter', nbp_glo, index_g)
+    var_name = 'flux10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 10, 1, itime, &
+         &                flux10, 'scatter', nbp_glo, index_g)
+    var_name = 'flux100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 100, 1, itime, &
+         &                flux100, 'scatter', nbp_glo, index_g)
+
+    var_name = 'convflux'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              convflux, 'scatter', nbp_glo, index_g)
+    var_name = 'cflux_prod10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              cflux_prod10, 'scatter', nbp_glo, index_g)
+    var_name = 'cflux_prod100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              cflux_prod100, 'scatter', nbp_glo, index_g)
+
+    var_name = 'convfluxpft'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              convfluxpft, 'scatter', nbp_glo, index_g)
+
+    var_name = 'fDeforestToProduct'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              fDeforestToProduct, 'scatter', nbp_glo, index_g)
+
+    var_name = 'fLulccResidue'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              fLulccResidue, 'scatter', nbp_glo, index_g)
+
+    var_name = 'fHarvestToProduct'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              fHarvestToProduct, 'scatter', nbp_glo, index_g)
+
+    !-
+    ! 18-bis wood harvest
+    !-
+    IF (do_wood_harvest) THEN
+       var_name = 'prod10_harvest'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 11, 1, itime, &
+            prod10_harvest, 'scatter', nbp_glo, index_g)
+       var_name = 'prod100_harvest'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 101, 1, itime, &
+            prod100_harvest, 'scatter', nbp_glo, index_g)
+       var_name = 'flux10_harvest'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 10, 1, itime, &
+            flux10_harvest, 'scatter', nbp_glo, index_g)
+       var_name = 'flux100_harvest'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 100, 1, itime, &
+            flux100_harvest, 'scatter', nbp_glo, index_g)
+       var_name = 'convflux_harvest'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            convflux_harvest, 'scatter', nbp_glo, index_g)
+       var_name = 'cflux_prod10_harvest'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            cflux_prod10_harvest, 'scatter', nbp_glo, index_g)
+       var_name = 'cfluxprod100_harvest'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            cflux_prod100_harvest, 'scatter', nbp_glo, index_g)
+       var_name = 'woodharvestpft'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            woodharvestpft, 'scatter', nbp_glo, index_g)
+    END IF
+
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                bm_to_litter(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+
+    var_name = 'carb_mass_total'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              carb_mass_total, 'scatter', nbp_glo, index_g)
+    !-
+    ! 19. Spinup
+    !-
+    IF (spinup_analytic) THEN
+
+       IF (is_root_prc) THEN
+          temp_global_years(1) = REAL(global_years)
+          var_name='Global_years'
+          CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, temp_global_years)
+       ENDIF
+       
+       var_name = 'nbp_sum'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &              nbp_accu, 'scatter', nbp_glo, index_g)
+
+       var_name = 'nbp_flux'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &              nbp_flux, 'scatter', nbp_glo, index_g)
+
+       var_name = 'ok_equilibrium'
+       WHERE(ok_equilibrium(:))
+          ok_equilibrium_real = un
+       ELSEWHERE
+          ok_equilibrium_real = zero
+       ENDWHERE
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &               ok_equilibrium_real, 'scatter', nbp_glo, index_g)
+       
+       DO k = 1,nbpools
+          DO j = 1,nbpools
+             WRITE(part_str,'(I2)') k
+             IF (k < 10) part_str(1:1) = '0'             
+             var_name = '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
+
+    ENDIF !(spinup_analytic)
+
+
+    DO k = 1,npco2
+       WRITE(part_str,'(I2)') k
+       IF (k < 10) part_str(1:1) = '0' 
+       var_name = 'assim_param_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                assim_param(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+       
+
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving writerestart'
+    !--------------------------
+  END SUBROUTINE writerestart
+  !-
+  !===
+  !-
+END MODULE stomate_io
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_lcchange.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_lcchange.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_lcchange.f90	(revision 8430)
@@ -0,0 +1,378 @@
+! =================================================================================================================================
+! MODULE       : stomate_lcchange
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Impact of land cover change on carbon stocks
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_lcchange
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC lcchange_main
+  
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : lcchange_main
+!!
+!>\BRIEF        Impact of land cover change on carbon stocks
+!!
+!! DESCRIPTION  : This subroutine is always activate if VEGET_UPDATE>0Y in the configuration file, which means that the 
+!! vegetation map is updated regulary. lcchange_main is called from stomateLpj the first time step after the vegetation 
+!! map has been changed. 
+!! The impact of land cover change on carbon stocks is computed in this subroutine. The land cover change is written
+!! by the difference of current and previous "maximal" coverage fraction of a PFT. 
+!! On the basis of this difference, the amount of 'new establishment'/'biomass export',
+!! and increase/decrease of each component, are estimated.\n
+!!
+!! Main structure of lpj_establish.f90 is:
+!! 1. Initialization
+!! 2. Calculation of changes in carbon stocks and biomass by land cover change
+!! 3. Update 10 year- and 100 year-turnover pool contents
+!! 4. History
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::prod10, ::prod100, ::flux10, ::flux100,
+!!   :: cflux_prod10 and :: cflux_prod100 
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{lcchange.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  
+  SUBROUTINE lcchange_main ( npts, dt_days, veget_cov_max_old, veget_cov_max_new, &
+       biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, &        
+       co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, &
+       prod10,prod100,convflux,cflux_prod10,cflux_prod100,leaf_frac,&
+       npp_longterm, lm_lastyearmax, litter, carbon,&
+       convfluxpft, fDeforestToProduct, fLulccResidue)
+
+    
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER, INTENT(in)                                       :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                                   :: dt_days          !! Time step of vegetation dynamics for stomate
+                                                                                  !! (days)
+    REAL(r_std), DIMENSION(nvm, nparts,nelements), INTENT(in) :: bm_sapl          !! biomass of sapling 
+                                                                                  !! @tex ($gC individual^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_cov_max_old!! Current "maximal" coverage fraction of a PFT (LAI
+                                                                                  !! -> infinity) on ground
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_cov_max_new!! New "maximal" coverage fraction of a PFT (LAI ->
+                                                                                  !! infinity) on ground (unitless) 
+ 
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: convflux         !! release during first year following land cover
+                                                                                  !! change
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: cflux_prod10     !! total annual release from the 10 year-turnover
+                                                                                  !! pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: cflux_prod100    !! total annual release from the 100 year-
+                                                                                  !! turnover pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily   !! Turnover rates 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: convfluxpft      !! release during first year following land cover                                       
+                                                                                  !! change   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: fDeforestToProduct !!  Deforested biomass into product pool due to anthorpogenic 
+                                                                                    !! land use change
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: fLulccResidue      !!  carbon mass flux into soil and litter due to anthropogenic land use or land cover change
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass    !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind              !! Number of individuals @tex ($m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age              !! mean age (years)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence       !! plant senescent (only for deciduous trees) Set
+                                                                                  !! to .FALSE. if PFT is introduced or killed
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent       !! Is pft there (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere       !! is the PFT everywhere in the grid box or very 
+                                                                                  !! localized (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit  !! how many days ago was the beginning of the 
+                                                                                  !! growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm        !! biomass uptaken 
+                                                                                  !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter 
+                                                                                  !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind           !! crown area of individuals 
+                                                                                  !! @tex ($m^{2}$) @endtex
+    REAL(r_std), DIMENSION(npts,0:10), INTENT(inout)          :: prod10           !! products remaining in the 10 year-turnover
+                                                                                  !! pool after the annual release for each 
+                                                                                  !! compartment (10 + 1 : input from year of land
+                                                                                  !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100), INTENT(inout)         :: prod100          !! products remaining in the 100 year-turnover
+                                                                                  !! pool after the annual release for each 
+                                                                                  !! compartment (100 + 1 : input from year of land
+                                                                                  !! cover change)
+    REAL(r_std), DIMENSION(npts,10), INTENT(inout)            :: flux10           !! annual release from the 10/100 year-turnover 
+                                                                                  !! pool compartments
+    REAL(r_std), DIMENSION(npts,100), INTENT(inout)           :: flux100          !! annual release from the 10/100 year-turnover
+                                                                                  !! pool compartments
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac        !! fraction of leaves in leaf age class 
+                                                                                  !! (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: lm_lastyearmax   !! last year's maximum leaf mass for each PFT 
+                                                                                  !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm     !! "long term" net primary productivity 
+                                                                                  !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,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), INTENT(inout)      :: carbon           !! carbon pool: active, slow, or passive 
+
+                                                                                 !! @tex ($gC m^{-2}$) @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: i, j, k, l, m    !! indices (unitless)
+    REAL(r_std),DIMENSION(npts,nelements)                     :: bm_new           !! biomass increase @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nparts,nelements)              :: biomass_loss     !! biomass loss @tex ($gC m^{-2}$) @endtex
+    REAL(r_std)                                               :: above            !! aboveground biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nlevs,nelements)         :: dilu_lit         !! Litter dilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,ncarb)                         :: dilu_soil_carbon !! Soil Carbondilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(nvm)                                :: delta_veg        !! changes in "maximal" coverage fraction of PFT 
+    REAL(r_std)                                               :: delta_veg_sum    !! sum of delta_veg
+    REAL(r_std),DIMENSION(npts,nvm)                           :: delta_ind        !! change in number of individuals  
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering lcchange_main'
+    
+  !! 1. initialization
+    
+    prod10(:,0)         = zero
+    prod100(:,0)        = zero   
+    above               = zero
+    convflux(:)         = zero
+    convfluxpft(:,:)    = zero
+    cflux_prod10(:)     = zero
+    cflux_prod100(:)    = zero
+    delta_ind(:,:)      = zero
+    delta_veg(:)        = zero
+    fDeforestToProduct(:,:)  = zero
+    fLulccResidue(:,:)       = zero
+
+
+    
+  !! 3. calculation of changes in carbon stocks and biomass by land cover change\n
+    
+    DO i = 1, npts ! Loop over # pixels - domain size
+       
+       !! 3.1 initialization of carbon stocks\n
+       delta_veg(:) = veget_cov_max_new(i,:)-veget_cov_max_old(i,:)
+       delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.0.)
+       
+       dilu_lit(i,:,:,:) = zero
+       dilu_soil_carbon(i,:) = zero
+       biomass_loss(i,:,:) = zero
+       
+       !! 3.2 if vegetation coverage decreases, compute dilution of litter, soil carbon, and biomass.\n
+       DO j=2, nvm
+          IF ( delta_veg(j) < -min_stomate ) THEN 
+             dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) + delta_veg(j)*litter(i,:,j,:,:) / delta_veg_sum
+             dilu_soil_carbon(i,:) =  dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum
+             biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum
+          ENDIF
+       ENDDO
+       
+       !! 3.3 
+       DO j=2, nvm ! Loop over # PFTs
+
+          !! 3.3.1 The case that vegetation coverage of PFTj increases
+          IF ( delta_veg(j) > min_stomate) THEN
+
+             !! 3.3.1.1 Initial setting of new establishment
+             IF (veget_cov_max_old(i,j) .LT. min_stomate) THEN 
+                IF (is_tree(j)) THEN
+
+                   ! cn_sapl(j)=0.5; stomate_data.f90
+                   cn_ind(i,j) = cn_sapl(j) 
+                ELSE
+                   cn_ind(i,j) = un
+                ENDIF
+                ind(i,j)= delta_veg(j) / cn_ind(i,j)
+                PFTpresent(i,j) = .TRUE.
+                everywhere(i,j) = 1.
+                senescence(i,j) = .FALSE.
+                age(i,j) = zero
+
+                ! large_value = 1.E33_r_std
+                when_growthinit(i,j) = large_value 
+                leaf_frac(i,j,1) = 1.0
+                npp_longterm(i,j) = npp_longterm_init
+                lm_lastyearmax(i,j) = bm_sapl(j,ileaf,icarbon) * ind(i,j)
+             ENDIF
+             IF ( cn_ind(i,j) > min_stomate ) THEN
+                delta_ind(i,j) = delta_veg(j) / cn_ind(i,j) 
+             ENDIF
+             
+             !! 3.3.1.2 Update of biomass in each each carbon stock component 
+             !!         Update of biomass in each each carbon stock component (leaf, sapabove, sapbelow,
+             !>         heartabove, heartbelow, root, fruit, and carbres)\n
+             DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90 
+                DO l = 1,nelements ! loop over # elements
+
+                   bm_new(i,l) = delta_ind(i,j) * bm_sapl(j,k,l) 
+                   IF (veget_cov_max_old(i,j) .GT. min_stomate) THEN
+
+                      ! in the case that bm_new is overestimated compared with biomass?
+                      IF ((bm_new(i,l)/delta_veg(j)) > biomass(i,j,k,l)) THEN
+                         bm_new(i,l) = biomass(i,j,k,l)*delta_veg(j)
+                      ENDIF
+                   ENDIF
+                   biomass(i,j,k,l) = ( biomass(i,j,k,l) * veget_cov_max_old(i,j) + bm_new(i,l) ) / veget_cov_max_new(i,j)
+                   co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)* dt_days) / (one_year * veget_cov_max_new(i,j))
+                END DO ! loop over # elements
+             ENDDO ! loop over # carbon stock components
+
+             !! 3.3.1.3 Calculation of dilution in litter, soil carbon, and  input of litter
+             !!        In this 'IF statement', dilu_* is zero. Formulas for litter and soil carbon
+             !!         could be shortend?? Are the following formulas correct?
+
+             ! Litter
+             litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_cov_max_old(i,j) + &
+                  dilu_lit(i,:,:,:) * delta_veg(j)) / veget_cov_max_new(i,j)
+            
+             ! Soil carbon
+             carbon(i,:,j)=(carbon(i,:,j) * veget_cov_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_cov_max_new(i,j)
+
+             DO l = 1,nelements
+
+                ! Litter input
+                bm_to_litter(i,j,isapbelow,l) = (bm_to_litter(i,j,isapbelow,l) * veget_cov_max_old(i,j) + &
+                     biomass_loss(i,isapbelow,l)*delta_veg(j)) / veget_cov_max_new(i,j)
+                bm_to_litter(i,j,iheartbelow,l) = (bm_to_litter(i,j,iheartbelow,l) * veget_cov_max_old(i,j) + &
+                     biomass_loss(i,iheartbelow,l) *delta_veg(j)) / veget_cov_max_new(i,j)
+                bm_to_litter(i,j,iroot,l) = (bm_to_litter(i,j,iroot,l) * veget_cov_max_old(i,j) + &
+                     biomass_loss(i,iroot,l)*delta_veg(j)) / veget_cov_max_new(i,j)
+                bm_to_litter(i,j,ifruit,l) = (bm_to_litter(i,j,ifruit,l) * veget_cov_max_old(i,j) + &
+                     biomass_loss(i,ifruit,l)*delta_veg(j)) / veget_cov_max_new(i,j)
+                bm_to_litter(i,j,icarbres,l) = (bm_to_litter(i,j,icarbres,l) * veget_cov_max_old(i,j) + &
+                     biomass_loss(i,icarbres,l)   *delta_veg(j)) / veget_cov_max_new(i,j)
+                bm_to_litter(i,j,ileaf,l) = (bm_to_litter(i,j,ileaf,l) * veget_cov_max_old(i,j) + &
+                     biomass_loss(i,ileaf,l)*delta_veg(j)) / veget_cov_max_new(i,j)
+
+             END DO
+
+             age(i,j)=age(i,j)*veget_cov_max_old(i,j)/veget_cov_max_new(i,j)
+             
+          !! 3.3.2 The case that vegetation coverage of PFTj is no change or decreases
+          ELSE 
+ 
+             !! 3.3.2.1 Biomass export
+             ! coeff_lcchange_*:  Coeff of biomass export for the year, decade, and century
+             above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon)
+             convflux(i)  = convflux(i)  - ( coeff_lcchange_1(j) * above * delta_veg(j) ) 
+             convfluxpft(i,j)= convfluxpft(i,j) - (coeff_lcchange_1(j) * above * delta_veg(j) )
+             prod10(i,0)  = prod10(i,0)  - ( coeff_lcchange_10(j) * above * delta_veg(j) )
+             prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) )
+
+             fDeforestToProduct(i,j) = - above * delta_veg(j)
+             fLulccResidue(i,j) = - ( biomass(i,j,isapbelow,icarbon) &
+                  + biomass(i,j,iheartbelow,icarbon) &
+                  + biomass(i,j,iroot,icarbon) &
+                  + biomass(i,j,ifruit,icarbon) &
+                  + biomass(i,j,icarbres,icarbon) &
+                  + biomass(i,j,ileaf,icarbon) ) * delta_veg(j)
+             !! 3.3.2.2 Total reduction
+             !! If the vegetation is to small, it has been set to 0.
+             IF ( veget_cov_max_new(i,j) .LT. min_stomate ) THEN 
+                
+                ind(i,j) = zero
+                biomass(i,j,:,:) = zero
+                PFTpresent(i,j) = .FALSE.
+                senescence(i,j) = .FALSE.
+                age(i,j) = zero
+                when_growthinit(i,j) = undef
+                everywhere(i,j) = zero
+                carbon(i,:,j) = zero
+                litter(i,:,j,:,:) = zero
+                bm_to_litter(i,j,:,:) = zero
+                turnover_daily(i,j,:,:) = zero
+                
+             ENDIF
+ 
+          ENDIF ! End if PFT's coverage reduction
+          
+       ENDDO ! Loop over # PFTs
+       
+       !! 3.4 update 10 year-turnover pool content following flux emission
+       !!     (linear decay (10%) of the initial carbon input)
+       DO  l = 0, 8
+          m = 10 - l
+          cflux_prod10(i) =  cflux_prod10(i) + flux10(i,m)
+          prod10(i,m)     =  prod10(i,m-1)   - flux10(i,m-1)
+          flux10(i,m)     =  flux10(i,m-1)
+          
+          IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero
+       ENDDO
+       
+       cflux_prod10(i) = cflux_prod10(i) + flux10(i,1) 
+       flux10(i,1)     = 0.1 * prod10(i,0)
+       prod10(i,1)     = prod10(i,0)
+       
+       !! 3.5 update 100 year-turnover pool content following flux emission\n
+       DO   l = 0, 98
+          m = 100 - l
+          cflux_prod100(i)  =  cflux_prod100(i) + flux100(i,m)
+          prod100(i,m)      =  prod100(i,m-1)   - flux100(i,m-1)
+          flux100(i,m)      =  flux100(i,m-1)
+          
+          IF (prod100(i,m).LT.1.0) prod100(i,m) = zero
+       ENDDO
+       
+       cflux_prod100(i)  = cflux_prod100(i) + flux100(i,1) 
+       flux100(i,1)      = 0.01 * prod100(i,0)
+       prod100(i,1)      = prod100(i,0)
+       prod10(i,0)        = zero
+       prod100(i,0)       = zero 
+
+       
+    ENDDO ! Loop over # pixels - domain size
+    
+  !! 4. history
+    convflux        = convflux/one_year*dt_days
+    convfluxpft     = convfluxpft/one_year*dt_days
+    fDeforestToProduct= fDeforestToProduct/one_year*dt_days
+    fLulccResidue   = fLulccResidue/one_year*dt_days
+    cflux_prod10    = cflux_prod10/one_year*dt_days
+    cflux_prod100   = cflux_prod100/one_year*dt_days
+
+   
+    IF (printlev>=4) WRITE(numout,*) 'Leaving lcchange_main'
+    
+  END SUBROUTINE lcchange_main
+  
+END MODULE stomate_lcchange
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_litter.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_litter.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_litter.f90	(revision 8430)
@@ -0,0 +1,957 @@
+! =================================================================================================================================
+! MODULE       : stomate_litter
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Update litter and lignine content after litter fall and 
+!! calculating litter decomposition.      
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_litter
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC littercalc,littercalc_clear, deadleaf
+
+  LOGICAL, SAVE                        :: firstcall_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, &
+       litterpart, litter, dead_leaves, lignin_struc, &
+       deadleaf_cover, resp_hetero_litter, &
+       soilcarbon_input, control_temp, control_moist, &
+       MatrixA, VectorB)
+
+    !! 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,nslm), INTENT(in)               :: tsoil              !! Soil temperature (K)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)               :: soilhum            !! Daily soil humidity of each soil layer 
+                                                                                      !! (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: litterhum          !! Daily litter humidity (unitless)
+
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts), INTENT(out)                   :: deadleaf_cover     !! Fraction of soil covered by dead leaves 
+                                                                                      !! over all PFTs (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)               :: resp_hetero_litter !! Litter heterotrophic respiration. The unit
+                                                                                      !! is given by m^2 of ground.  
+                                                                                      !! @tex $(gC dt_sechiba one\_day^{-1}) m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(out)         :: soilcarbon_input   !! Quantity of carbon going into carbon pools
+                                                                                      !! from litter decomposition. The unit is  
+                                                                                      !! given by m^2 of ground 
+                                                                                      !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(out)             :: control_temp       !! Temperature control of heterotrophic 
+                                                                                      !! respiration, above and below (0-1, 
+                                                                                      !! unitless)
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(out)             :: control_moist      !! Moisture control of heterotrophic 
+                                                                                      !! respiration (0.25-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(out) :: MatrixA          !! Matrix containing the fluxes between the
+                                                                                      !! carbon pools per sechiba time step 
+                                                                                      !! @tex $(gC.m^2.day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out)         :: VectorB          !! Vector containing the litter increase per
+                                                                                      !! sechiba time step
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+   
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)       :: litterpart         !! Fraction of litter above the ground 
+                                                                                      !! belonging to the different PFTs (0-1, 
+                                                                                      !! unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,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)
+    
+    !! 0.4 Local variables
+ 
+    REAL(r_std)                                                 :: dt                 !! Number of sechiba(fast processes) time-step per day 
+    REAL(r_std), SAVE, DIMENSION(nparts,nlitt)                  :: litterfrac         !! The fraction of leaves, wood, etc. that 
+                                                                                      !! goes into metabolic and structural 
+                                                                                      !! litterpools (0-1, unitless)
+!$OMP THREADPRIVATE(litterfrac)
+    REAL(r_std), SAVE, 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_tau         !! Turnover time in litter pools (days)
+!$OMP THREADPRIVATE(litter_tau)
+    REAL(r_std), SAVE, DIMENSION(nlitt,ncarb,nlevs)             :: frac_soil          !! Fraction of litter that goes into soil 
+                                                                                      !! (litter -> carbon, above and below). The
+                                                                                      !! remaining part goes to the atmosphere
+!$OMP THREADPRIVATE(frac_soil)
+    REAL(r_std), DIMENSION(npts)                                :: tsoil_decomp       !! Temperature used for decompostition in 
+                                                                                      !! soil (K)
+    REAL(r_std), DIMENSION(npts)                                :: soilhum_decomp     !! Humidity used for decompostition in soil
+                                                                                      !! (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: fd                 !! Fraction of structural or metabolic litter
+                                                                                      !! decomposed (unitless)
+    REAL(r_std), DIMENSION(npts,nelements)                      :: qd                 !! Quantity of structural or metabolic litter
+                                                                                      !! decomposed @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlevs)                      :: old_struc          !! Old structural litter, above and below 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nlevs,nelements)      :: litter_inc_PFT     !! Increase of litter, per PFT, metabolic and
+                                                                                      !! structural, above and below ground. The 
+                                                                                      !! unit is given by m^2 of ground.  
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,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,nlitt,nelements)            :: litter_pft         !! Metabolic and structural litter above the 
+                                                                                      !! ground per PFT
+    REAL(r_std), DIMENSION(npts)                                :: zdiff_min          !! Intermediate field for looking for minimum
+                                                                                      !! of what? this is not used in the code. 
+                                                                                      !! [??CHECK] could we delete it?
+    CHARACTER(LEN=10), DIMENSION(nlitt)                         :: litter_str         !! Messages to write output information about
+                                                                                      !! the litter
+    CHARACTER(LEN=22), DIMENSION(nparts)                        :: part_str           !! Messages to write output information about
+                                                                                      !! the plant
+    CHARACTER(LEN=7), DIMENSION(ncarb)                          :: carbon_str         !! Messages to write output information about
+                                                                                      !! the soil carbon
+    CHARACTER(LEN=5), DIMENSION(nlevs)                          :: level_str          !! Messages to write output information about
+                                                                                      !! the level (aboveground or belowground litter)
+    INTEGER(i_std)                                              :: i,j,k,l,m          !! Indices (unitless)
+    INTEGER(i_std)                                              :: ier                !! Error handling
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering littercalc'
+
+  !! 1. Initialisations of the different fields during the first call of the routine 
+    dt = dt_sechiba/one_day
+    IF ( firstcall_litter ) THEN
+
+       !! 1.1.3 litter fractions:
+       !!   what fraction of leaves, wood, etc. goes into metabolic and structural litterpools
+       DO k = 1, nparts
+
+          litterfrac(k,imetabolic) = metabolic_ref_frac - metabolic_LN_ratio * LC(k) * CN(k)
+          litterfrac(k,istructural) = un - litterfrac(k,imetabolic)
+
+       ENDDO
+
+       !! 1.1.4 residence times in litter pools (days)
+       litter_tau(imetabolic) = tau_metabolic * one_year      ! .5 years
+       litter_tau(istructural) = tau_struct * one_year     ! 3 years
+
+       !! 1.1.5 decomposition flux fraction that goes into soil
+       !       (litter -> carbon, above and below)
+       !       1-frac_soil goes into atmosphere
+       frac_soil(:,:,:) = zero
+
+       ! structural litter: lignin fraction goes into slow pool + respiration,
+       !                    rest into active pool + respiration
+       frac_soil(istructural,iactive,iabove) = frac_soil_struct_aa
+       frac_soil(istructural,iactive,ibelow) = frac_soil_struct_ab
+       frac_soil(istructural,islow,iabove) = frac_soil_struct_sa
+       frac_soil(istructural,islow,ibelow) = frac_soil_struct_sb
+
+       ! metabolic litter: all goes into active pool + respiration.
+       !   Nothing into slow or passive pool.
+       frac_soil(imetabolic,iactive,iabove) = frac_soil_metab_aa
+       frac_soil(imetabolic,iactive,ibelow) = frac_soil_metab_ab
+
+       
+       !! 1.2 soil levels
+       ALLOCATE(z_soil(0:nslm), stat=ier)
+       IF ( ier /= 0 ) CALL ipslerr_p(3,'littercalc','Pb in allocate of z_soil','','')
+
+       z_soil(0) = zero
+       z_soil(1:nslm) = diaglev(1:nslm)
+
+       
+       !! 1.3 messages
+       litter_str(imetabolic) = 'metabolic'
+       litter_str(istructural) = 'structural'
+
+       carbon_str(iactive) = 'active'
+       carbon_str(islow) = 'slow'
+       carbon_str(ipassive) = 'passive'
+
+       level_str(iabove) = 'above'
+       level_str(ibelow) = 'below'
+
+       part_str(ileaf) = 'leaves'
+       part_str(isapabove) = 'sap above ground'
+       part_str(isapbelow) = 'sap below ground'
+       part_str(iheartabove) = 'heartwood above ground'
+       part_str(iheartbelow) = 'heartwood below ground'
+       part_str(iroot) = 'roots'
+       part_str(ifruit) = 'fruits'
+       part_str(icarbres) = 'carbohydrate reserve'
+
+       IF (printlev >=2) THEN
+          WRITE(numout,*) 'litter:'
+
+          WRITE(numout,*) '   > C/N ratios: '
+          DO k = 1, nparts
+             WRITE(numout,*) '       ', part_str(k), ': ',CN(k)
+          ENDDO
+
+          WRITE(numout,*) '   > Lignine/C ratios: '
+          DO k = 1, nparts
+             WRITE(numout,*) '       ', part_str(k), ': ',LC(k)
+          ENDDO
+
+          WRITE(numout,*) '   > fraction of compartment that goes into litter: '
+          DO k = 1, nparts
+             DO m = 1, nlitt
+                WRITE(numout,*) '       ', part_str(k), '-> ',litter_str(m), ':',litterfrac(k,m)
+             ENDDO
+          ENDDO
+
+          WRITE(numout,*) '   > scaling depth for decomposition (m): ',z_decomp
+
+          WRITE(numout,*) '   > minimal carbon residence time in litter pools (d):'
+          DO m = 1, nlitt
+             WRITE(numout,*) '       ',litter_str(m),':',litter_tau(m)
+          ENDDO
+
+          WRITE(numout,*) '   > litter decomposition flux fraction that really goes '
+          WRITE(numout,*) '     into carbon pools (rest into the atmosphere):'
+          DO m = 1, nlitt
+             DO l = 1, nlevs
+                DO k = 1, ncarb
+                   WRITE(numout,*) '       ',litter_str(m),' ',level_str(l),' -> ',&
+                        carbon_str(k),':', frac_soil(m,k,l)
+                ENDDO
+             ENDDO
+          ENDDO
+       END IF ! printlev >=2
+       firstcall_litter = .FALSE.
+
+    ENDIF
+
+    
+    !! 1.3 litter above the ground per PFT.
+    DO j = 1, nvm ! Loop over # PFTs
+
+       DO k = 1, nlitt !Loop over litter pool
+          litter_pft(:,j,k,icarbon) = litterpart(:,j,k) * litter(:,k,j,iabove,icarbon)
+       ENDDO
+
+    ENDDO
+
+    
+    !! 1.4 set output to zero
+    deadleaf_cover(:) = zero
+    resp_hetero_litter(:,:) = zero
+    soilcarbon_input(:,:,:) = zero
+
+    
+  !! 2. Add biomass to different litterpools (per m^2 of ground)
+    
+    !! 2.1 first, save old structural litter (needed for lignin fractions).
+    !     above/below
+    DO l = 1, nlevs !Loop over litter levels (above and below ground)
+       DO m = 1,nvm !Loop over PFTs
+
+          old_struc(:,m,l) = litter(:,istructural,m,l,icarbon)
+
+       ENDDO
+    ENDDO
+
+    
+    !! 2.2 update litter, dead leaves, and lignin content in structural litter
+    litter_inc(:,:,:,:,:) = zero
+    lignin_struc_inc(:,:,:) = zero
+
+    DO j = 1,nvm !Loop over PFTs
+
+       !! 2.2.1 litter
+       DO k = 1, nlitt    !Loop over litter pools (metabolic and structural)
+
+          !! 2.2.2 calculate litter increase (per m^2 of ground).
+          !       Only a given fracion of fruit turnover is directly coverted into litter.
+          !       Litter increase for each PFT, structural and metabolic, above/below
+          litter_inc_PFT(:,j,k,iabove,icarbon) = &
+               litterfrac(ileaf,k) * bm_to_litter(:,j,ileaf,icarbon) + &
+               litterfrac(isapabove,k) * bm_to_litter(:,j,isapabove,icarbon) + &
+               litterfrac(iheartabove,k) * bm_to_litter(:,j,iheartabove,icarbon) + &
+               litterfrac(ifruit,k) * bm_to_litter(:,j,ifruit,icarbon) + &
+               litterfrac(icarbres,k) * bm_to_litter(:,j,icarbres,icarbon) + &
+               litterfrac(ileaf,k) * turnover(:,j,ileaf,icarbon) + &
+               litterfrac(isapabove,k) * turnover(:,j,isapabove,icarbon) + &
+               litterfrac(iheartabove,k) * turnover(:,j,iheartabove,icarbon) + &
+               litterfrac(ifruit,k) * turnover(:,j,ifruit,icarbon) + &
+               litterfrac(icarbres,k) * turnover(:,j,icarbres,icarbon)
+
+          litter_inc_PFT(:,j,k,ibelow,icarbon) = &
+               litterfrac(isapbelow,k) * bm_to_litter(:,j,isapbelow,icarbon) + &
+               litterfrac(iheartbelow,k) * bm_to_litter(:,j,iheartbelow,icarbon) + &
+               litterfrac(iroot,k) * bm_to_litter(:,j,iroot,icarbon) + &
+               litterfrac(isapbelow,k) * turnover(:,j,isapbelow,icarbon) + &
+               litterfrac(iheartbelow,k) * turnover(:,j,iheartbelow,icarbon) + &
+               litterfrac(iroot,k) * turnover(:,j,iroot,icarbon)
+
+          ! litter increase, met/struct, above/below
+          litter_inc(:,k,j,iabove,icarbon) = litter_inc(:,k,j,iabove,icarbon) + litter_inc_PFT(:,j,k,iabove,icarbon)
+          litter_inc(:,k,j,ibelow,icarbon) = litter_inc(:,k,j,ibelow,icarbon) + litter_inc_PFT(:,j,k,ibelow,icarbon)
+
+          !! 2.2.3 dead leaves, for soil cover.
+          dead_leaves(:,j,k) = &
+               dead_leaves(:,j,k) + &
+               litterfrac(ileaf,k) * ( bm_to_litter(:,j,ileaf,icarbon) + turnover(:,j,ileaf,icarbon) )
+
+          !! 2.2.4 lignin increase in structural litter
+          IF ( k .EQ. istructural ) THEN
+
+             lignin_struc_inc(:,j,iabove) = &
+                  lignin_struc_inc(:,j,iabove) + &
+                  LC(ileaf) * bm_to_litter(:,j,ileaf,icarbon) + &
+                  LC(isapabove) * bm_to_litter(:,j,isapabove,icarbon) + &
+                  LC(iheartabove) * bm_to_litter(:,j,iheartabove,icarbon) + &
+                  LC(ifruit) * bm_to_litter(:,j,ifruit,icarbon) + &
+                  LC(icarbres) * bm_to_litter(:,j,icarbres,icarbon) + &
+                  LC(ileaf) * turnover(:,j,ileaf,icarbon) + &
+                  LC(isapabove) * turnover(:,j,isapabove,icarbon) + &
+                  LC(iheartabove) * turnover(:,j,iheartabove,icarbon) + &
+                  LC(ifruit) * turnover(:,j,ifruit,icarbon) + &
+                  LC(icarbres) * turnover(:,j,icarbres,icarbon)
+
+             lignin_struc_inc(:,j,ibelow) = &
+                  lignin_struc_inc(:,j,ibelow) + &
+                  LC(isapbelow) * bm_to_litter(:,j,isapbelow,icarbon) + &
+                  LC(iheartbelow) * bm_to_litter(:,j,iheartbelow,icarbon) + &
+                  LC(iroot) * bm_to_litter(:,j,iroot,icarbon) + &
+                  LC(isapbelow)*turnover(:,j,isapbelow,icarbon) + &
+                  LC(iheartbelow)*turnover(:,j,iheartbelow,icarbon) + &
+                  LC(iroot)*turnover(:,j,iroot,icarbon)
+
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+    !! 2.2.5 add new litter (struct/met, above/below)
+    litter(:,:,:,:,:) = litter(:,:,:,:,:) + litter_inc(:,:,:,:,:)
+
+    !! 2.2.6 for security: can't add more lignin than structural litter (above/below)
+    DO l = 1, nlevs !Loop over litter levels (above and below ground)
+       DO m = 1,nvm !Lopp over PFTs
+
+          lignin_struc_inc(:,m,l) = &
+               MIN( lignin_struc_inc(:,m,l), litter_inc(:,istructural,m,l,icarbon) )
+
+       ENDDO
+    ENDDO
+
+    !! 2.2.7 new lignin content: add old lignin and lignin increase, divide by 
+    !!       total structural litter (above/below)
+    DO l = 1, nlevs !Loop over litter levels (above and below ground)
+       DO m = 1,nvm !Loop over PFTs
+          WHERE( litter(:,istructural,m,l,icarbon) .GT. min_stomate )
+
+       !MM : Soenke modif
+       ! Best vectorization ?
+!!$       lignin_struc(:,:,:) = &
+!!$            ( lignin_struc(:,:,:)*old_struc(:,:,:) + lignin_struc_inc(:,:,:) ) / &
+!!$            litter(:,istructural,:,:,icarbon)
+
+             lignin_struc(:,m,l) = lignin_struc(:,m,l) * old_struc(:,m,l)
+             lignin_struc(:,m,l) = lignin_struc(:,m,l) + lignin_struc_inc(:,m,l)
+             lignin_struc(:,m,l) = lignin_struc(:,m,l) / litter(:,istructural,m,l,icarbon)
+          ELSEWHERE
+             lignin_struc(:,m,l) = zero
+          ENDWHERE
+       ENDDO
+    ENDDO
+
+    
+    !! 2.3 new litter fraction per PFT (for structural and metabolic litter, above
+    !!       the ground).
+    DO j = 1,nvm !Loop over PFTs
+
+       WHERE ( litter(:,:,j,iabove,icarbon) .GT. min_stomate )
+
+          litterpart(:,j,:) = &
+               ( litter_pft(:,j,:,icarbon) + litter_inc_PFT(:,j,:,iabove,icarbon) ) / litter(:,:,j,iabove,icarbon)
+
+       ELSEWHERE
+
+          litterpart(:,j,:) = zero
+
+       ENDWHERE
+
+    ENDDO
+
+    
+  !! 3. Temperature control on decay: Factor between 0 and 1
+
+    !! 3.1 above: surface temperature
+    control_temp(:,iabove) = control_temp_func (npts, tsurf)
+
+    
+    !! 3.2 below: convolution of temperature and decomposer profiles
+    !!            (exponential decomposer profile supposed)
+   
+    !! 3.2.1 rpc is an integration constant such that the integral of the root profile is 1.
+    rpc(:) = un / ( un - EXP( -z_soil(nslm) / z_decomp ) )
+
+    !! 3.2.2 integrate over the nslm levels
+    tsoil_decomp(:) = zero
+
+    DO l = 1, nslm
+
+       tsoil_decomp(:) = &
+            tsoil_decomp(:) + tsoil(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_decomp ) - EXP( -z_soil(l)/z_decomp ) )
+
+    ENDDO
+
+    control_temp(:,ibelow) = control_temp_func (npts, tsoil_decomp)
+
+  !! 4. Moisture control. Factor between 0 and 1
+    
+    !! 4.1 above the ground: litter humidity
+    control_moist(:,iabove) = control_moist_func (npts, litterhum)
+
+    !
+    !! 4.2 below: convolution of humidity and decomposer profiles
+    !            (exponential decomposer profile supposed)
+
+    !! 4.2.1 rpc is an integration constant such that the integral of the root profile is 1.
+    rpc(:) = un / ( un - EXP( -z_soil(nslm) / z_decomp ) )
+
+    !! 4.2.2 integrate over the nslm levels
+    soilhum_decomp(:) = zero
+
+    DO l = 1, nslm !Loop over soil levels
+
+       soilhum_decomp(:) = &
+            soilhum_decomp(:) + soilhum(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_decomp ) - EXP( -z_soil(l)/z_decomp ) )
+
+    ENDDO
+
+    control_moist(:,ibelow) = control_moist_func (npts, soilhum_decomp)
+
+  !! 5. fluxes from litter to carbon pools and respiration
+
+    DO l = 1, nlevs !Loop over litter levels (above and below ground)
+       DO m = 1,nvm !Loop over PFTs
+
+          !! 5.1 structural litter: goes into active and slow carbon pools + respiration
+
+          !! 5.1.1 total quantity of structural litter which is decomposed
+          fd(:) = dt/litter_tau(istructural) * &
+               control_temp(:,l) * control_moist(:,l) * exp( -litter_struct_coef * lignin_struc(:,m,l) )
+
+          DO k = 1,nelements
+             
+             qd(:,k) = litter(:,istructural,m,l,k) * fd(:)
+
+          END DO
+
+          litter(:,istructural,m,l,:) = litter(:,istructural,m,l,:) - qd(:,:)
+
+          !! 5.1.2 decompose same fraction of structural part of dead leaves. Not exact
+          !!       as lignine content is not the same as that of the total structural litter.
+          ! to avoid a multiple (for ibelow and iabove) modification of dead_leaves,
+          ! we do this test to do this calcul only ones in 1,nlev loop
+          if (l == iabove)  dead_leaves(:,m,istructural) = dead_leaves(:,m,istructural) * ( un - fd(:) )
+
+          !! 5.1.3 non-lignin fraction of structural litter goes into
+          !!       active carbon pool + respiration
+          soilcarbon_input(:,iactive,m) = soilcarbon_input(:,iactive,m) + &
+               frac_soil(istructural,iactive,l) * qd(:,icarbon) * ( 1. - lignin_struc(:,m,l) ) / dt
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dt_sechiba/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(istructural,iactive,l) ) * qd(:,icarbon) * &
+               ( 1. - lignin_struc(:,m,l) ) / dt
+
+          !! 5.1.4 lignin fraction of structural litter goes into
+          !!       slow carbon pool + respiration
+          soilcarbon_input(:,islow,m) = soilcarbon_input(:,islow,m) + &
+               frac_soil(istructural,islow,l) * qd(:,icarbon) * lignin_struc(:,m,l) / dt
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dt_sechiba/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(istructural,islow,l) ) * qd(:,icarbon) * lignin_struc(:,m,l) / dt
+
+          
+          !! 5.2 metabolic litter goes into active carbon pool + respiration
+         
+          !! 5.2.1 total quantity of metabolic litter that is decomposed
+          fd(:) = dt/litter_tau(imetabolic) * control_temp(:,l) * control_moist(:,l)
+
+          DO k = 1,nelements
+          
+             qd(:,k) = litter(:,imetabolic,m,l,k) * fd(:)
+
+          END DO
+
+          litter(:,imetabolic,m,l,:) = litter(:,imetabolic,m,l,:) - qd(:,:)
+
+          !! 5.2.2 decompose same fraction of metabolic part of dead leaves.
+          !  to avoid a multiple (for ibelow and iabove) modification of dead_leaves,
+          !  we do this test to do this calcul only ones in 1,nlev loop
+          if (l == iabove)  dead_leaves(:,m,imetabolic) = dead_leaves(:,m,imetabolic) * ( 1. - fd(:) )
+
+
+          !! 5.2.3 put decomposed litter into carbon pool + respiration
+          soilcarbon_input(:,iactive,m) = soilcarbon_input(:,iactive,m) + &
+               frac_soil(imetabolic,iactive,l) * qd(:,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 dt_sechiba/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(imetabolic,iactive,l) ) * qd(:,icarbon) / dt
+
+       ENDDO
+    ENDDO
+
+    
+  !! 6. calculate fraction of total soil covered by dead leaves
+
+    CALL deadleaf (npts, veget_cov_max, dead_leaves, deadleaf_cover)
+
+  !! 7. (Quasi-)Analytical Spin-up : Start filling MatrixA
+
+    IF (spinup_analytic) THEN
+
+       MatrixA(:,:,:,:) = zero
+       VectorB(:,:,:) = zero
+       
+       
+       DO m = 1,nvm
+
+          !- MatrixA : carbon fluxes leaving the litter
+          
+          MatrixA(:,m,istructural_above,istructural_above)= - dt/litter_tau(istructural) * &
+               control_temp(:,iabove) * control_moist(:,iabove) * exp( -litter_struct_coef * lignin_struc(:,m,iabove) )
+          
+          MatrixA(:,m,istructural_below,istructural_below) = - dt/litter_tau(istructural) * &
+               control_temp(:,ibelow) * control_moist(:,ibelow) * exp( -litter_struct_coef * lignin_struc(:,m,ibelow) )
+          
+          MatrixA(:,m,imetabolic_above,imetabolic_above) = - dt/litter_tau(imetabolic) * & 
+               control_temp(:,iabove) * control_moist(:,iabove)
+          
+          MatrixA(:,m,imetabolic_below,imetabolic_below) = - dt/litter_tau(imetabolic) * & 
+               control_temp(:,ibelow) * control_moist(:,ibelow)
+          
+          
+          !- MatrixA : carbon fluxes between the litter and the pools (the rest of the matrix is filled in stomate_soilcarbon.f90)
+          
+          MatrixA(:,m,iactive_pool,istructural_above) = frac_soil(istructural,iactive,iabove) * &
+               dt/litter_tau(istructural) * &                    
+               control_temp(:,iabove) * control_moist(:,iabove) * & 
+               exp( -litter_struct_coef * lignin_struc(:,m,iabove) ) * &
+               ( 1. - lignin_struc(:,m,iabove) ) 
+          
+
+          MatrixA(:,m,iactive_pool,istructural_below) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &                     
+               control_temp(:,ibelow) * control_moist(:,ibelow) * & 
+               exp( -litter_struct_coef * lignin_struc(:,m,ibelow) ) * &
+               ( 1. - lignin_struc(:,m,ibelow) ) 
+          
+          
+          MatrixA(:,m,iactive_pool,imetabolic_above) =  frac_soil(imetabolic,iactive,iabove) * &
+               dt/litter_tau(imetabolic) * control_temp(:,iabove) * control_moist(:,iabove) 
+          
+          
+          MatrixA(:,m,iactive_pool,imetabolic_below) =  frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp(:,ibelow) * control_moist(:,ibelow)
+          
+          MatrixA(:,m,islow_pool,istructural_above) = frac_soil(istructural,islow,iabove) * &
+               dt/litter_tau(istructural) * &                   
+               control_temp(:,iabove) * control_moist(:,iabove) * &
+               exp( -litter_struct_coef * lignin_struc(:,m,iabove) )* &
+               lignin_struc(:,m,iabove)
+          
+          
+          MatrixA(:,m,islow_pool,istructural_below) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &   
+               control_temp(:,ibelow) * control_moist(:,ibelow) *  &
+                  exp( -litter_struct_coef * lignin_struc(:,m,ibelow) )* &
+                  lignin_struc(:,m,ibelow) 
+          
+          
+          !- VectorB : carbon input -
+          
+          VectorB(:,m,istructural_above) = litter_inc_PFT(:,m,istructural,iabove,icarbon)
+          VectorB(:,m,istructural_below) = litter_inc_PFT(:,m,istructural,ibelow,icarbon)
+          VectorB(:,m,imetabolic_above) = litter_inc_PFT(:,m,imetabolic,iabove,icarbon)
+          VectorB(:,m,imetabolic_below) = litter_inc_PFT(:,m,imetabolic,ibelow,icarbon)
+          
+          IF (printlev>=4) WRITE(numout,*) 'We filled MatrixA and VectorB' 
+          
+       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 (vegetmax) using the following equations:
+!! \latexonly
+!! \input{deadleaf1.tex}
+!! \endlatexonly
+!! \n
+!! Then, the dead leaf cover (DLC) is calculated as following:\n
+!! \latexonly
+!! \input{deadleaf2.tex}
+!! \endlatexonly
+!! \n
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE: ::deadleaf_cover
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE deadleaf (npts, veget_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)                                      :: j              !! Index (unitless)
+!_ ================================================================================================================================
+    
+  !! 1. LAI of dead leaves
+  
+    dead_lai(:) = zero
+
+    DO j = 1,nvm !Loop over PFTs
+       dead_lai(:) = dead_lai(:) + ( dead_leaves(:,j,imetabolic) + dead_leaves(:,j,istructural) ) * sla(j) &
+            * veget_cov_max(:,j)
+    ENDDO
+
+  !! 2. fraction of soil covered by dead leaves
+
+    deadleaf_cover(:) = un - exp( - 0.5 * dead_lai(:) )
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving deadleaf'
+
+  END SUBROUTINE deadleaf
+
+
+!! ================================================================================================================================
+!! FUNCTION     : control_moist_func
+!!
+!>\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-AFP/src_stomate/stomate_lpj.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_lpj.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_lpj.f90	(revision 8430)
@@ -0,0 +1,1897 @@
+! ================================================================================================================================
+! MODULE       : stomate_lpj
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Main entry point for daily processes in STOMATE and LPJ (phenology, 
+!! allocation, npp_calc, kill, turn, light, establish, crown, cover, lcchange)
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_lpj
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE xios_orchidee
+  USE grid
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE lpj_constraints
+  USE lpj_pftinout
+  USE lpj_kill
+  USE lpj_crown
+  USE lpj_fire
+  USE lpj_gap
+  USE lpj_light
+  USE lpj_establish
+  USE lpj_cover
+  USE stomate_prescribe
+  USE stomate_phenology
+  USE stomate_alloc
+  USE stomate_npp
+  USE stomate_turnover
+  USE stomate_litter
+  USE stomate_soilcarbon
+  USE stomate_vmax
+  USE stomate_lcchange
+  USE stomate_woodharvest
+!   USE stomete, ONLY : setlai 
+
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC StomateLpj,StomateLpj_clear
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : StomateLpj_clear
+!!
+!>\BRIEF        Re-initialisation of variable
+!!
+!! DESCRIPTION  : This subroutine reinitializes variables. To be used if we want to relaunch 
+!! ORCHIDEE but the routine is not used in current version.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE StomateLpj_clear
+
+    CALL prescribe_clear
+    CALL phenology_clear
+    CALL npp_calc_clear
+    CALL turn_clear
+    CALL soilcarbon_clear
+    CALL constraints_clear
+    CALL establish_clear
+    CALL fire_clear
+    CALL gap_clear
+    CALL light_clear
+    CALL pftinout_clear
+    CALL alloc_clear
+  END SUBROUTINE StomateLpj_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : StomateLPJ
+!!
+!>\BRIEF        Main entry point for daily processes in STOMATE and LPJ, structures the call sequence 
+!!              to the different processes such as dispersion, establishment, competition and mortality of PFT's.
+!! 
+!! DESCRIPTION  : This routine is the main entry point to all processes calculated on a 
+!! daily time step. Is mainly devoted to call the different STOMATE and LPJ routines 
+!! depending of the ok_dgvm (is dynamic veg used) and lpj_constant_mortality (is background mortality used).
+!! It also prepares the cumulative 
+!! fluxes or pools (e.g TOTAL_M TOTAL_BM_LITTER etc...)
+!!
+!! This routine makes frequent use of "weekly", "monthly" and "long term" variables. Quotion is used because
+!! by default "weekly" denotes 7 days, by default "monthly" denotes 20 days and by default "Long term" denotes
+!! 3 years. dtslow refers to 24 hours (1 day).
+!!
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): All variables related to stomate and required for LPJ dynamic vegetation mode.
+!!
+!! REFERENCE(S) : 
+!! - Krinner, G., N. Viovy, N. de Noblet-DucoudrÃ©, J. OgeÃ©, J. Polcher, P. Friedlingstein, P. Ciais, S. Sitch, 
+!! and I. C. Prentice. 2005. A dynamic global vegetation model for studies of the coupled atmosphere-biosphere 
+!! system. Global Biogeochemical Cycles 19:GB1015, doi:1010.1029/2003GB002199.
+!! - Sitch, S., B. Smith, I. C. Prentice, A. Arneth, A. Bondeau, W. Cramer, J. O. Kaplan, S. Levis, W. Lucht, 
+!! M. T. Sykes, K. Thonicke, and S. Venevsky. 2003. Evaluation of ecosystem dynamics, plant geography and 
+!! terrestrial carbon cycling in the LPJ dynamic global vegetation model. Global Change Biology 9:161-185.
+!!
+!! FLOWCHART    : Update with existing flowchart from N Viovy (Jan 19, 2012)
+!! \n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE StomateLpj (npts, dt_days, &
+       neighbours, resolution, &
+       clay, herbivores, &
+       tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
+       litterhum_daily, soilhum_daily, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       gdd0_lastyear, precip_lastyear, &
+       moiavail_month, moiavail_week, t2m_longterm, t2m_month, t2m_week, &
+       tsoil_month, soilhum_month, &
+       gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       turnover_longterm, gpp_daily,&
+     !!xchen
+       gpp_week, VPD_daily, VPD_week,swdown_daily,swdown_week, & 
+       days_since_beg, precip_week,& !! liulyc  add date, liulye  days_since_beg, date is days_since_beg from stomate, stomate io, LPj
+       time_hum_min, maxfpc_lastyear, resp_maint_part, &
+       PFTpresent, age, fireindex, firelitter, &
+       leaf_age, leaf_frac, biomass, ind, adapted, regenerate, &
+       senescence, when_growthinit, &
+       litterpart, litter, dead_leaves, carbon, lignin_struc, &
+       veget_cov_max, veget_cov_max_new, woodharvest, fraclut, npp_longterm, lm_lastyearmax, veget_lastlight, &
+       everywhere, need_adjacent, RIP_time, &
+       lai,&
+
+!!!@xchen lai for leaf age class1-4 for caculating PC in Wu's science paper
+       lai_cl1,lai_cl2,lai_cl3,lai_cl4,laitop,laidow,VPD,ave_VPD,swdown,& 
+
+       rprof,npp_daily, turnover_daily, turnover_time,&
+       control_moist, control_temp, soilcarbon_input, &
+       co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, &
+       height, deadleaf_cover, vcmax, &
+
+!!!@xchen vcmax for leaf age class1-4 for caculating PC in Wu's science paper     
+       vcmax_cl1, vcmax_cl2,vcmax_cl3,vcmax_cl4, delta_turnover, & 
+
+       bm_to_litter, &
+       prod10,prod100,flux10, flux100, &
+       convflux,cflux_prod10,cflux_prod100, &
+       prod10_harvest,prod100_harvest,flux10_harvest, flux100_harvest, &
+       convflux_harvest,cflux_prod10_harvest,cflux_prod100_harvest, woodharvestpft, &
+       convfluxpft, fDeforestToProduct, fLulccResidue,fHarvestToProduct, &
+       harvest_above, carb_mass_total, fpc_max, MatrixA, &
+       Tseason, Tmin_spring_time, begin_leaves, onset_date)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 input
+
+    INTEGER(i_std), INTENT(in)                                 :: npts                 !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                                    :: dt_days              !! Time step of Stomate (days)
+    INTEGER(i_std), DIMENSION(npts,NbNeighb), INTENT(in)       :: neighbours           !! Indices of the 8 neighbours of each grid 
+                                                                                       !! point [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] 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: clay                 !! Clay fraction (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: herbivores           !! Time constant of probability of a leaf to 
+                                                                                       !! be eaten by a herbivore (days) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: tsurf_daily          !! Daily surface temperatures (K)
+    REAL(r_std), DIMENSION(npts,nslm), 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)
+
+    INTEGER(i_std),INTENT(in)                                  :: days_since_beg       !! Date (days)  liulyc add date is days_since_beg from stomate, stomate io, LPj
+
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: litterhum_daily      !! Daily litter humidity (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)              :: soilhum_daily        !! Daily soil humidity (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxmoiavail_lastyear !! Last year's maximum moisture availability 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: minmoiavail_lastyear !! Last year's minimum moisture availability 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: gdd0_lastyear        !! Last year's GDD0 (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: precip_lastyear      !! Lastyear's precipitation 
+                                                                                       !! @tex $(mm year^{-1})$ @endtex
+										       !! to determine if establishment possible
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_month       !! "Monthly" moisture availability (0 to 1, 
+                                                                                       !! unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week        !! "Weekly" moisture availability 
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_longterm         !! "Long term" 2 meter reference 
+                                                                                       !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_month            !! "Monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_week             !! "Weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: Tseason              !! "seasonal" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: Tmin_spring_time     !! Number of days after begin_leaves (leaf onset) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: onset_date           !! Date in the year at when the leaves started to grow(begin_leaves)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)              :: tsoil_month          !! "Monthly" soil temperatures (K)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)              :: soilhum_month        !! "Monthly" soil humidity
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_m5_dormance      !! Growing degree days (K), threshold -5 deg 
+                                                                                       !! C (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_from_growthinit  !! growing degree days, since growthinit for crops
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gdd_midwinter        !! Growing degree days (K), since midwinter 
+                                                                                       !! (for phenology) - this is written to the history files 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: ncd_dormance         !! Number of chilling days (days), since 
+                                                                                       !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: ngd_minus5           !! Number of growing days (days), threshold 
+                                                                                       !! -5 deg C (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)        :: turnover_longterm    !! "Long term" turnover rate  
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gpp_daily            !! Daily gross primary productivity  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+
+!! liuly
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gpp_week             !! Mean weekly gross primary productivity 
+                                                                                       !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: VPD_daily            !! xchen Daily VPD
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: VPD_week             !! xchen weekly VPD
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: swdown_daily         !! xchen daily swdown   
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: swdown_week          !! xchen weekly swdown
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: precip_week          !! xchen weekly swdown
+
+
+    
+!! liuly above
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: time_hum_min         !! Time elapsed since strongest moisture 
+                                                                                       !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxfpc_lastyear      !! Last year's maximum foliage projected
+                                                                                       !! coverage for each natural PFT,
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)        :: resp_maint_part      !! Maintenance respiration of different 
+                                                                                       !! plant parts  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: fpc_max              !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground  
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)                :: veget_cov_max_new    !! New "maximal" coverage fraction of a PFT 
+    REAL(r_std), DIMENSION(npts),INTENT(in)                    :: woodharvest          !! Harvested wood biomass (gC m-2 yr-1)
+    REAL(r_std),DIMENSION(npts, nlut),INTENT(in)               :: fraclut              !! Fraction of landuse tile
+
+  !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: npp_daily            !! Net primary productivity 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover_daily       !! Turnover rates 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: co2_to_bm            !! CO2 taken up from atmosphere when 
+                                                                                       !! introducing a new PFT (introduced for 
+                                                                                       !! carbon balance closure) 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: co2_fire             !! Carbon emitted into the atmosphere by 
+                                                                                       !! fire (living and dead biomass)  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: resp_hetero          !! Heterotrophic respiration
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: resp_maint           !! Maintenance respiration  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: resp_growth          !! Growth respiration  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: deadleaf_cover       !! Fraction of soil covered by dead leaves 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax                !! Maximum rate of carboxylation 
+
+!! liuly
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax_cl1            !! @xchen  Maximum rate of carboxylation
+                                                                                       !! for leaf age 1
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax_cl2            !! leaf age 2 
+                                                                                       !! 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax_cl3            !! leaf age 3 
+                                                                                       !! 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax_cl4            !! leaf age 4
+                                                                                       !! unit ($\mu mol m^{-2} s^{-1}$)
+    REAL(r_std), DIMENSION(npts), INTENT(IN)                   :: swdown               
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: delta_turnover       !! Intermediate variable for turnover ?? 
+!! liuly above
+
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out):: bm_to_litter      !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(out)                  :: begin_leaves         !! signal to start putting leaves on (true/false)
+
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: height               !! Height of vegetation (m) 
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(inout)          :: control_moist        !! Moisture control of heterotrophic 
+                                                                                       !! respiration (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(inout)          :: control_temp         !! Temperature control of heterotrophic 
+                                                                                       !! respiration, above and below 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout)      :: soilcarbon_input     !! Quantity of carbon going into carbon 
+                                                                                       !! pools from litter decomposition  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lai                  !! Leaf area index OF AN INDIVIDUAL PLANT,
+										       !! where a PFT contains n indentical plants
+										       !! i.e., using the mean individual approach 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+!! liuly    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: lai_cl1               !! @xchen to add lai of each leaf class age and for calculating PC in wu's science paper
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: lai_cl2        
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: lai_cl3        
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: lai_cl4
+!! xchen add vpd for gpp simulation in Amazon                                   
+    REAL(r_std), DIMENSION(npts),     INTENT (in)             :: VPD                   !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(npts),     INTENT (out)            :: ave_VPD               !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: laitop                !!xchen Wu (science, 2016) sunlit leaf area index @tex ($m^2 m^{-2}$) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: laidow                !!xchen Wu (science 2016) shade leaf area index @tex ($m^2 m^{-2}$)
+!! liuly above
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: rprof                !! Prescribed root depth (m) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: PFTpresent           !! Tab indicating which PFTs are present in 
+                                                                                       !! each pixel 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: age                  !! Age (years)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: fireindex            !! Probability of fire (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: firelitter           !! Longer term litter above the ground that 
+                                                                                       !! can be burned, @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age             !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac            !! Fraction of leaves in leaf age class, 
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: ind                  !! Density of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: adapted              !! Adaptation of PFT (killed if too cold) 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: regenerate           !! "Fitness": Winter sufficiently cold for 
+                                                                                       !! PFT regeneration ? (0 to 1, unitless) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: senescence           !! Flag for setting senescence stage (only 
+                                                                                       !! for deciduous trees) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: when_growthinit      !! How many days ago was the beginning of 
+                                                                                       !! the growing season (days) 
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)      :: litterpart           !! Fraction of litter above the ground 
+                                                                                       !! belonging to different PFTs
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,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), INTENT(inout)      :: carbon               !! 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), INTENT(inout)            :: veget_cov_max        !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: npp_longterm         !! "Long term" mean yearly primary 
+                                                                                       !! productivity 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lm_lastyearmax       !! Last year's maximum leaf mass, for each 
+                                                                                       !! PFT @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: veget_lastlight      !! Vegetation fractions (on ground) after 
+                                                                                       !! last light competition  
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: everywhere           !! Is the PFT everywhere in the grid box or 
+                                                                                       !! very localized (after its introduction) 
+                                                                                       !! (unitless) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: need_adjacent        !! In order for this PFT to be introduced, 
+                                                                                       !! does it have to be present in an 
+                                                                                       !! adjacent grid box? 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: RIP_time             !! How much time ago was the PFT eliminated 
+                                                                                       !! for the last time (y) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: turnover_time        !! Turnover_time of leaves for grasses 
+                                                                                       !! (days)
+    REAL(r_std),DIMENSION(npts,0:10), INTENT(inout)            :: prod10               !! Products remaining in the 10
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (10
+                                                                                       !! + 1 : input from year of land cover 
+                                                                                       !! change) @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,0:100), INTENT(inout)           :: prod100              !! Products remaining in the 100 
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (100 
+                                                                                       !! + 1 : input from year of land cover 
+                                                                                       !! change) @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,10), INTENT(inout)              :: flux10               !! Annual release from the 10
+                                                                                       !! year-turnover pool compartments  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,100), INTENT(inout)             :: flux100              !! Annual release from the 100 
+                                                                                       !! year-turnover pool compartments  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: convflux             !! Release during first year following land 
+                                                                                       !! cover change @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: cflux_prod10         !! Total annual release from the 10 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: cflux_prod100        !! Total annual release from the 100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,0:10), INTENT(inout)            :: prod10_harvest       !! Products remaining in the 10
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (10
+                                                                                       !! + 1 : input from year of wood harvest)
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,0:100), INTENT(inout)           :: prod100_harvest      !! Products remaining in the 100 
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (100 
+                                                                                       !! + 1 : input from year of wood harvest)
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,10), INTENT(inout)              :: flux10_harvest       !! Annual release from the 10
+                                                                                       !! year-turnover pool compartments  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,100), INTENT(inout)             :: flux100_harvest      !! Annual release from the 100 
+                                                                                       !! year-turnover pool compartments  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: convflux_harvest     !! Release during first year following wood 
+                                                                                       !! harvest @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: cflux_prod10_harvest !! Total annual release from the 10 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: cflux_prod100_harvest!! Total annual release from the 100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm), INTENT(inout)             :: woodharvestpft       !! Harvested wood biomass (gC m-2 dt_stomate-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: convfluxpft         !! Convflux per PFT
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: fDeforestToProduct  !! Deforested biomass into product pool due to anthropogenic 
+                                                                                       !! land use change
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: fLulccResidue       !! Carbon mass flux into soil and litter due to anthropogenic land use or land cover change
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: fHarvestToProduct   !! Deforested biomass into product pool due to anthropogenic 
+                                                                                       !! land use 
+
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: harvest_above        !! Harvest above ground biomass for 
+                                                                                       !! agriculture @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: carb_mass_total      !! Carbon Mass total (soil, litter, veg) 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(inout) :: MatrixA         !! Matrix containing the fluxes  
+                                                                                       !! between the carbon pools
+                                                                                       !! per sechiba time step 
+                                                                                       !! @tex $(gC.m^2.day^{-1})$ @endtex
+
+    !! 0.4 Local variables
+
+    !!xchen
+    REAL(r_std), DIMENSION(npts,nvm)                            ::var_lai
+    REAL(r_std), DIMENSION(npts,nvm)                            :: dturnover_leaf      !! xchen1111 Intermediate variable for turnover ??
+
+    !! liulyc add a variable to represent total litterfall (total litterfall = tot_bm_to_litter + tot_turnover)
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: tot_litterfall    !! Total conversion of biomass to litter 
+
+
+    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,nelements)                  :: cOther              !! Carbon Mass in Vegetation Components 
+                                                                                       !! other than Leaves, Stems and Roots
+                                                                                       !! @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)                                :: sum_cLitterGrass    !! Carbon mass in litter on grass tiles
+                                                                                       !! @tex $(kgC !m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts)                                :: sum_cLitterCrop     !! Carbon mass in litter on crop tiles
+                                                                                       !! @tex $(kgC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                :: sum_cSoilGrass      !! Carbon mass in soil on grass tiles 
+                                                                                       !! @tex $(kgC !m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                :: sum_cSoilCrop       !! Carbon mass in soil on crop tiles
+                                                                                       !! @tex $(kgC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                :: sum_cVegGrass       !! Carbon mass in vegetation on grass tiles 
+                                                                                       !! @tex $(kgC !m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                :: sum_cVegCrop        !! Carbon mass in vegetation on crop tiles
+                                                                                       !! @tex $(kgC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                :: sum_cLitterTree     !! Carbon mass in litter on tree tiles
+                                                                                       !! @tex $(kgC !!m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts)                                :: sum_cSoilTree       !! Carbon mass in soil on tree tiles 
+                                                                                       !! @tex $(kgC !m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                :: sum_cVegTree        !! Carbon mass in vegetation on tree tiles 
+                                                                                       !! @tex $(kgC !m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                :: carb_mass_variation !! Carbon Mass variation  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: cn_ind              !! Crown area of individuals 
+                                                                                       !! @tex $(m^{2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: woodmass_ind        !! Woodmass of individuals (gC) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts)                     :: f_alloc             !! Fraction that goes into plant part 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: avail_tree          !! Space availability for trees 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: avail_grass         !! Space availability for grasses 
+                                                                                       !! (0 to 1, unitless) 
+    INTEGER                                                     :: j,k
+    REAL(r_std),DIMENSION(npts)                                 :: prod10_total        !! Total products remaining in the pool 
+                                                                                       !! after the annual release 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: prod100_total       !! Total products remaining in the pool 
+                                                                                       !! after the annual release 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: cflux_prod_total    !! Total flux from conflux and the 10/100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: prod10_harvest_total!! Total products remaining in the pool 
+                                                                                       !! after the annual release 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: prod100_harvest_total!! Total products remaining in the pool 
+                                                                                       !! after the annual release 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: cflux_prod_harvest_total!! Total flux from conflux and the 10/100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm)                             :: veget_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,nlut)                           :: clitterlut          !! Litter carbon on landusetype4 (nlut)
+    REAL(r_std), DIMENSION(npts,nlut)                           :: csoillut            !! Soil carbon on landusetype4 (nlut)
+    REAL(r_std), DIMENSION(npts,nlut)                           :: cveglut             !! Carbon in vegetation on landusetype4 (nlut)
+    REAL(r_std), DIMENSION(npts,nlut)                           :: lailut              !! LAI on landusetype4 (nlut)
+    REAL(r_std), DIMENSION(npts,nlut)                           :: ralut               !! Autotrophic respiration on landusetype4 (nlut) 
+    REAL(r_std), DIMENSION(npts,nlut)                           :: rhlut               !! Heterotrophic respiration on landusetype4 (nlut) 
+    REAL(r_std), DIMENSION(npts,nlut)                           :: npplut              !! Net Primary Productivity on landusetype4 (nlut)    
+    REAL(r_std), DIMENSION(npts,nlut)                           :: ctotfirelut         !! Fire CO2 emission on landusetype4 (nlut) 
+    REAL(r_std), DIMENSION(npts,nlut)                           :: cproductlut
+    REAL(r_std), DIMENSION(npts,nlut)                           :: flulccatmlut
+    REAL(r_std), DIMENSION(npts,nlut)                           :: flulccproductlut
+    REAL(r_std), DIMENSION(npts,nlut)                           :: flulccresiduelut
+    REAL(r_std), DIMENSION(npts,ncarb)                          :: csoilpools          !! Diagnostics for carbon in soil pools
+
+!! liulyq
+!!xchen
+    INTEGER(i_std)                                             :: var_date
+    REAL(r_std), DIMENSION(npts)                               :: LtoLSR               !! Ratio between leaf-allocation and 
+                                                                                       !! (leaf+sapwood+root)-allocation 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: StoLSR               !! Ratio between sapwood-allocation and 
+                                                                                       !! (leaf+sapwood+root)-allocation 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: RtoLSR               !! Ratio between root-allocation and 
+                                                                                       !! (leaf+sapwood+root)-allocation 
+                                                                                       !! (0-1, unitless)
+!! liuly above
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering stomate_lpj'
+
+  
+  !! 1. Initializations
+    
+    !! 1.1 Initialize variables to zero
+    co2_to_bm(:,:) = zero
+    co2_fire(:,:) = zero
+    npp_daily(:,:) = zero
+!!@xchen
+    lai_cl1(:,:) = zero
+    lai_cl2(:,:) = zero                                                           
+    lai_cl3(:,:) = zero                                                           
+    lai_cl4(:,:) = zero  
+
+    resp_maint(:,:) = zero
+    resp_growth(:,:) = zero
+    harvest_above(:) = zero
+    bm_to_litter(:,:,:,:) = zero
+    cn_ind(:,:) = zero
+    woodmass_ind(:,:) = zero
+    turnover_daily(:,:,:,:) = zero
+
+    !!xchen
+    var_date = zero   !! liulya those below 3 lines are moved here because some lines removed in this verion of ORCHIDEE and may need further work 
+    
+    !! liulya below 2 have IF in xchen,check it need?
+    delta_turnover(:,:) = zero     !!xchen1111 !! liulya 
+    dturnover_leaf(:,:) = zero     !!xchen1111 !! liulya 
+    
+    !! 1.2  Initialize variables to veget_cov_max
+    veget_cov_max_tmp(:,:) = veget_cov_max(:,:)
+
+    !! 1.3 Calculate some vegetation characteristics
+    
+    !! 1.3.1 Calculate some vegetation characteristics 
+    !        Calculate cn_ind (individual crown mass) and individual height from
+    !        state variables if running DGVM or dynamic mortality in static cover mode
+    !??        Explain (maybe in the header once) why you mulitply with veget_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
+
+    !! 1.3.2 Prescribe characteristics if the vegetation is not dynamic
+    !        IF the DGVM is not activated, the density of individuals and their crown
+    !        areas don't matter, but they should be defined for the case we switch on
+    !        the DGVM afterwards. At the first call, if the DGVM is not activated, 
+    !        impose a minimum biomass for prescribed PFTs and declare them present.
+    CALL prescribe (npts, &
+         veget_cov_max, dt_days, PFTpresent, everywhere, when_growthinit, &
+         biomass, leaf_frac, ind, cn_ind, co2_to_bm)
+
+
+  !! 2. Climatic constraints for PFT presence and regenerativeness
+
+    !   Call this even when DGVM is not activated so that "adapted" and "regenerate"
+    !   are kept up to date for the moment when the DGVM is activated.
+    CALL constraints (npts, dt_days, &
+         t2m_month, t2m_min_daily,when_growthinit, Tseason, &
+         adapted, regenerate)
+
+    
+  !! 3. Determine introduction and elimination of PTS based on climate criteria
+ 
+    IF ( ok_dgvm ) THEN
+      
+       !! 3.1 Calculate introduction and elimination
+       CALL pftinout (npts, dt_days, adapted, regenerate, &
+            neighbours, veget_cov_max, &
+            biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
+            PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
+            co2_to_bm, &
+            avail_tree, avail_grass)
+
+       !! 3.2 Reset attributes for eliminated PFTs.
+       !     This also kills PFTs that had 0 leafmass during the last year. The message
+       !     "... after pftinout" is misleading in this case.
+       CALL kill (npts, 'pftinout  ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_cov_max, bm_to_litter)
+
+       
+       !! 3.3 Calculate woodmass of individual tree
+       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
+       
+       ! 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
+
+    !! 4.1 Write values to history file
+    !      Current values for ::when_growthinit 
+    CALL xios_orchidee_send_field("WHEN_GROWTHINIT",when_growthinit)
+
+    CALL histwrite_p (hist_id_stomate, 'WHEN_GROWTHINIT', itime, when_growthinit, npts*nvm, horipft_index)
+
+    ! Set and write values for ::PFTpresent
+    WHERE(PFTpresent)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("PFTPRESENT",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'PFTPRESENT', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for gdd_midwinter
+    WHERE(gdd_midwinter.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=gdd_midwinter
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("GDD_MIDWINTER",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'GDD_MIDWINTER', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for gdd_m5_dormance
+    WHERE(gdd_m5_dormance.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=gdd_m5_dormance
+    ENDWHERE
+    
+    CALL xios_orchidee_send_field('GDD_M5_DORMANCE',histvar)
+    CALL histwrite_p (hist_id_stomate, 'GDD_M5_DORMANCE', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for ncd_dormance
+    WHERE(ncd_dormance.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=ncd_dormance
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("NCD_DORMANCE",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'NCD_DORMANCE', itime, histvar, npts*nvm, horipft_index)
+
+    !! 4.2 Calculate phenology
+    CALL phenology (npts, dt_days, PFTpresent, &
+         veget_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, &
+         senescence, time_hum_min, &
+         biomass, leaf_frac, leaf_age, &
+         when_growthinit, co2_to_bm, &
+         begin_leaves)
+    
+  !! 5. Allocate C to different plant parts
+
+     !!xchen1111
+    !!WRITE(numout,*) 'dturnover_leaf before alloc in stomat_lpj: ', dturnover_leaf(:,:)
+    !!WRITE(numout,*) 'delta_turnover before alloc in stomat_lpj: ', delta_turnover(:,:)
+     var_date = days_since_beg+365                                                          
+     var_date = MOD(var_date, 365)
+     WRITE(numout,*) 'number of days in stomat_lpj: ',days_since_beg
+     WRITE(numout,*) 'number of var_days in stomat_lpj: ',var_date
+     !! liulyq what is MOD?
+    
+    CALL alloc (npts, dt_days, &
+         lai, veget_cov_max, senescence, when_growthinit, &
+         moiavail_week, tsoil_month, soilhum_month, &
+         biomass, age, leaf_age, leaf_frac, rprof, f_alloc,&
+
+         !!xchen1111
+         delta_turnover, var_date, VPD, swdown, swdown_week, LtoLSR, StoLSR, RtoLSR)
+
+     !! liulya below 5.1 is copy from AP-2D, need further check what happend?
+     !! 5.1. Recalculate lai
+     !!      This should be done whenever biomass is modified
+     !! CALL setlai(biomass, sla_calc, slai)
+     !! liulya above
+     !! liulyt  update lai 
+     ! CALL  setlai(npts, lai) !! liulyt 20200529 test lai change
+     
+     ! DO j=2,nvm
+     !      lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+     ! ENDDO
+
+     ! ! liulyt 
+     ! ! WRITE(numout,*) 'liulyt LAI0 in lpj is:', lai(:,0)
+     ! ! WRITE(numout,*) 'liulyt LAI1 in lpj is:', lai(:,1)
+     ! WRITE(numout,*) 'liulyt LAI2 in lpj is:', lai(:,2)
+
+
+
+  !! 6. NPP, maintenance and growth respiration
+
+    !! 6.1 Calculate NPP and respiration terms
+    CALL npp_calc (npts, dt_days, &
+         PFTpresent, &
+         t2m_daily, tsoil_daily, lai, rprof, &
+         !@xchen lai for leaf age class1-4 for caculating PC in Wu's science paper     
+         lai_cl1, lai_cl2, lai_cl3,lai_cl4, delta_turnover,var_date, & 
+         gpp_daily, f_alloc, bm_alloc, resp_maint_part,&
+         biomass, leaf_age, leaf_frac, age, &
+         resp_maint, resp_growth, npp_daily, co2_to_bm)
+
+    !! 6.2 Kill slow growing PFTs in DGVM or STOMATE with constant mortality
+    IF ( ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+       CALL kill (npts, 'npp       ', lm_lastyearmax,  &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_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
+    CALL fire (npts, dt_days, litterpart, &
+         litterhum_daily, t2m_daily, lignin_struc, veget_cov_max, &
+         fireindex, firelitter, biomass, ind, &
+         litter, dead_leaves, bm_to_litter, &
+         co2_fire, MatrixA)
+
+    !! 7.2 Kill PFTs in DGVM
+    IF ( ok_dgvm ) THEN
+
+       ! reset attributes for eliminated PFTs
+       CALL kill (npts, 'fire      ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_cov_max, bm_to_litter)
+
+    ENDIF ! ok_dgvm
+ 
+  !! 8. Tree mortality
+
+    ! Does not depend on age, therefore does not change crown area.
+    CALL gap (npts, dt_days, &
+         npp_longterm, turnover_longterm, lm_lastyearmax, &
+         PFTpresent, t2m_min_daily, Tmin_spring_time, &
+         biomass, ind, bm_to_litter, mortality)
+
+
+    IF ( ok_dgvm ) THEN
+
+       ! reset attributes for eliminated PFTs
+       CALL kill (npts, 'gap       ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_cov_max, bm_to_litter)
+
+    ENDIF
+
+  !! 9. Leaf senescence, new lai and other turnover processes
+
+    CALL turn (npts, dt_days, PFTpresent, &
+         var_date, dturnover_leaf, laitop, laidow, VPD,ave_VPD, VPD_daily, VPD_week, swdown_week, precip_week,& !!xchen liulye
+         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, lai, biomass, &
+         turnover_daily, senescence,turnover_time)
+
+    !! 10. Light competition
+    
+    !! If not using constant mortality then kill with light competition
+!    IF ( ok_dgvm .OR. .NOT.(lpj_gap_const_mort) ) THEN
+    IF ( ok_dgvm ) THEN
+ 
+       !! 10.1 Light competition
+       CALL light (npts, dt_days, &
+            veget_cov_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, &
+            lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality)
+       
+       !! 10.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
+
+    
+  !! 11. Establishment of saplings
+    
+    IF ( ok_dgvm .OR. .NOT.lpj_gap_const_mort ) THEN
+
+       !! 11.1 Establish new plants
+       CALL establish (npts, dt_days, PFTpresent, regenerate, &
+            neighbours, resolution, need_adjacent, herbivores, &
+            precip_lastyear, gdd0_lastyear, lm_lastyearmax, &
+            cn_ind, lai, avail_tree, avail_grass, npp_longterm, &
+            leaf_age, leaf_frac, &
+            ind, biomass, age, everywhere, co2_to_bm, veget_cov_max, woodmass_ind, &
+            mortality, bm_to_litter)
+
+       !! 11.2 Calculate new crown area (and maximum vegetation cover)
+       CALL crown (npts, PFTpresent, &
+            ind, biomass, woodmass_ind, &
+            veget_cov_max, cn_ind, height)
+
+    ENDIF
+
+  !! 12. Calculate final LAI and vegetation cover
+    
+    CALL cover (npts, cn_ind, ind, biomass, &
+         veget_cov_max, veget_cov_max_tmp, lai, &
+         litter, carbon, turnover_daily, bm_to_litter, &
+         co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, gpp_daily)
+
+  !! 13. Update litter pools to account for harvest
+ 
+    ! the whole litter stuff:
+    !    litter update, lignin content, PFT parts, litter decay, 
+    !    litter heterotrophic respiration, dead leaf soil cover.
+    !    No vertical discretisation in the soil for litter decay.\n
+    ! added by shilong for harvest
+    IF(harvest_agri) THEN
+       CALL harvest(npts, dt_days, veget_cov_max, &
+            bm_to_litter, turnover_daily, &
+            harvest_above)
+    ENDIF
+
+    !! 14. Land cover change if it is time to do so
+    !! The flag do_now_lcchange is set in slowproc_main at the same time as the vegetation is read from file.
+    !! The vegetation fractions are not updated yet and will be updated in the end of sechiba_main.
+    IF (do_now_stomate_woodharvest) THEN 
+       CALL woodharvest_main(npts, dt_days, veget_cov_max, &
+            biomass, &
+            flux10_harvest,flux100_harvest, prod10_harvest,prod100_harvest,&
+            convflux_harvest,cflux_prod10_harvest,cflux_prod100_harvest,&
+            woodharvest,woodharvestpft,fHarvestToProduct)
+       do_now_stomate_woodharvest=.FALSE.
+    ENDIF
+
+
+    IF (do_now_stomate_lcchange) THEN
+       CALL lcchange_main (npts, dt_days, veget_cov_max, veget_cov_max_new, &
+            biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, &
+            co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, &
+            prod10,prod100,convflux,cflux_prod10,cflux_prod100,leaf_frac,&
+            npp_longterm, lm_lastyearmax, litter, carbon, &
+            convfluxpft,  fDeforestToProduct, fLulccResidue)
+       do_now_stomate_lcchange=.FALSE.
+
+       ! Set the flag done_stomate_lcchange to be used in the end of sechiba_main to update the fractions.
+       done_stomate_lcchange=.TRUE.
+    ENDIF
+
+    !! liuly a liulyt in xchen 16. 
+     ! DO j=2,nvm
+     !      lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+     ! ENDDO
+
+    !! 15. Calculate vcmax 
+
+    CALL vmax (npts, dt_days, &
+         leaf_age, leaf_frac, &
+         vcmax, vcmax_cl1,vcmax_cl2,vcmax_cl3,vcmax_cl4,VPD_week, ave_VPD) !!xchen)
+
+    !MM dÃ©placement pour initialisation correcte des grandeurs cumulÃ©es :
+    cflux_prod_total(:) = convflux(:) + cflux_prod10(:) + cflux_prod100(:)
+    prod10_total(:)=SUM(prod10,dim=2)
+    prod100_total(:)=SUM(prod100,dim=2)
+
+    cflux_prod_harvest_total(:) = convflux_harvest(:) + cflux_prod10_harvest(:) + cflux_prod100_harvest(:)
+    prod10_harvest_total(:)=SUM(prod10_harvest,dim=2)
+    prod100_harvest_total(:)=SUM(prod100_harvest,dim=2)
+    
+  !! 16. Total heterotrophic respiration
+
+    tot_soil_carb(:,:) = zero
+    tot_litter_carb(:,:) = zero
+    sum_cLitterGrass = zero
+    sum_cLitterCrop = zero
+    sum_cSoilGrass = zero
+    sum_cSoilCrop = zero
+    sum_cVegGrass = zero
+    sum_cVegCrop = zero
+    sum_cLitterTree = zero
+    sum_cSoilTree = zero
+    sum_cVegTree = zero
+
+    DO j=2,nvm
+
+       tot_litter_carb(:,j) = tot_litter_carb(:,j) + (litter(:,istructural,j,iabove,icarbon) + &
+            &          litter(:,imetabolic,j,iabove,icarbon) + &
+            &          litter(:,istructural,j,ibelow,icarbon) + litter(:,imetabolic,j,ibelow,icarbon))
+
+      IF ((.NOT. is_tree(j))  .AND. natural(j)) THEN
+         sum_cLitterGrass(:) = sum_cLitterGrass(:) + tot_litter_carb(:,j)*veget_cov_max(:,j)
+      ELSE IF ((.NOT. is_tree(j))  .AND. (.NOT. natural(j)) ) THEN
+         sum_cLitterCrop(:) = sum_cLitterCrop(:) + tot_litter_carb(:,j)*veget_cov_max(:,j)
+      ELSE IF (is_tree(j)) THEN
+         sum_cLitterTree(:) = sum_cLitterTree(:) + tot_litter_carb(:,j)*veget_cov_max(:,j)
+      ENDIF
+
+      tot_soil_carb(:,j) = tot_soil_carb(:,j) + (carbon(:,iactive,j) + &
+           &          carbon(:,islow,j)+  carbon(:,ipassive,j))
+
+      IF ((.NOT. is_tree(j)) .AND. natural(j)) THEN
+         sum_cSoilGrass(:) = sum_cSoilGrass(:) + tot_soil_carb(:,j)*veget_cov_max(:,j)
+      ELSE IF ((.NOT. is_tree(j))  .AND. (.NOT. natural(j)) ) THEN
+         sum_cSoilCrop(:) = sum_cSoilCrop(:) + tot_soil_carb(:,j)*veget_cov_max(:,j)
+      ELSE IF (is_tree(j)) THEN
+         sum_cSoilTree(:) = sum_cSoilTree(:) + tot_soil_carb(:,j)*veget_cov_max(:,j)
+      END IF
+    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,:)
+
+    DO j= 1,nvm
+       cOther(:,j,:) = biomass(:,j,ifruit,:) + biomass(:,j,icarbres,:)
+
+       IF ((.NOT. is_tree(j))  .AND. natural(j)) THEN
+          sum_cVegGrass(:) = sum_cVegGrass(:) + tot_live_biomass(:,j,icarbon)*veget_cov_max(:,j)
+       ELSE IF ((.NOT. is_tree(j))  .AND. (.NOT. natural(j)) ) THEN
+          sum_cVegCrop(:) = sum_cVegCrop(:) + tot_live_biomass(:,j,icarbon)*veget_cov_max(:,j)
+       ELSE IF (is_tree(j)) THEN
+          sum_cVegTree(:) = sum_cVegTree(:) + tot_live_biomass(:,j,icarbon)*veget_cov_max(:,j)
+       ENDIF
+    END DO
+
+
+    tot_turnover(:,:,:) = turnover_daily(:,:,ileaf,:) + turnover_daily(:,:,isapabove,:) + &
+         &         turnover_daily(:,:,isapbelow,:) + turnover_daily(:,:,iheartabove,:) + &
+         &         turnover_daily(:,:,iheartbelow,:) + turnover_daily(:,:,iroot,:) + &
+         &         turnover_daily(:,:,ifruit,:) + turnover_daily(:,:,icarbres,:)
+
+    tot_bm_to_litter(:,:,:) = bm_to_litter(:,:,ileaf,:) + bm_to_litter(:,:,isapabove,:) +&
+         &             bm_to_litter(:,:,isapbelow,:) + bm_to_litter(:,:,iheartbelow,:) +&
+         &             bm_to_litter(:,:,iheartabove,:) + bm_to_litter(:,:,iroot,:) + &
+         &             bm_to_litter(:,:,ifruit,:) + bm_to_litter(:,:,icarbres,:)
+
+    carb_mass_variation(:)=-carb_mass_total(:)
+    carb_mass_total(:)=SUM((tot_live_biomass(:,:,icarbon)+tot_litter_carb+tot_soil_carb)*veget_cov_max,dim=2) + &
+         &                 (prod10_total + prod100_total) +  (prod10_harvest_total + prod100_harvest_total)
+    carb_mass_variation(:)=carb_mass_total(:)+carb_mass_variation(:)
+
+    !! liulyc add total litterfall
+    !! confirmed by xchen that total litterfall should be as follow
+    tot_litterfall = tot_turnover(:,:,:) + tot_bm_to_litter(:,:,:)
+
+!     !! liulyt move LAI_CL 1-4 from turnover to here
+!      DO j = 2,nvm                                                                
+!           sla_age2(:,j) = sla(j)*0.9                                           
+!           sla_age3(:,j) = sla(j)*0.85                                          
+!           sla_age4(:,j) = sla(j)*0.8                                           
+!      ENDDO                                                                       
+!      lai_cl2(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,2)*sla_age2(:,:)    
+!      lai_cl3(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,3)*sla_age3(:,:)    
+!      lai_cl4(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,4)*sla_age4(:,:)    
+!      lai_cl1(:,:) = lai(:,:) - lai_cl2(:,:) -lai_cl3(:,:) -lai_cl4(:,:)          
+!      CALL xios_orchidee_send_field("LAI_CL1",lai_cl1(:,:))                       
+!      CALL xios_orchidee_send_field("LAI_CL2",lai_cl2(:,:))                       
+!      CALL xios_orchidee_send_field("LAI_CL3",lai_cl3(:,:))                       
+!      CALL xios_orchidee_send_field("LAI_CL4",lai_cl4(:,:))
+    
+  !! 17. Write history
+
+    CALL xios_orchidee_send_field("RESOLUTION_X",resolution(:,1))
+    CALL xios_orchidee_send_field("RESOLUTION_Y",resolution(:,2))
+    CALL xios_orchidee_send_field("CONTFRAC_STOMATE",contfrac(:))
+    CALL xios_orchidee_send_field("T2M_MONTH",t2m_month)
+    CALL xios_orchidee_send_field("T2M_WEEK",t2m_week)
+    CALL xios_orchidee_send_field("TSEASON",Tseason)
+    CALL xios_orchidee_send_field("TMIN_SPRING_TIME", Tmin_spring_time)
+    CALL xios_orchidee_send_field("ONSET_DATE",onset_date)
+    CALL xios_orchidee_send_field("FPC_MAX",fpc_max)
+    CALL xios_orchidee_send_field("MAXFPC_LASTYEAR",maxfpc_lastyear)
+    CALL xios_orchidee_send_field("HET_RESP",resp_hetero(:,:))
+    CALL xios_orchidee_send_field("CO2_FIRE",co2_fire)
+    CALL xios_orchidee_send_field("CO2_TAKEN",co2_to_bm)
+    CALL xios_orchidee_send_field("LAI",lai)
+    CALL xios_orchidee_send_field("VEGET_COV_MAX",veget_cov_max)
+    CALL xios_orchidee_send_field("NPP_STOMATE",npp_daily)
+    CALL xios_orchidee_send_field("GPP",gpp_daily)
+    CALL xios_orchidee_send_field("IND",ind)
+    CALL xios_orchidee_send_field("CN_IND",cn_ind)
+    CALL xios_orchidee_send_field("WOODMASS_IND",woodmass_ind)
+    CALL xios_orchidee_send_field("TOTAL_M",tot_live_biomass)
+    CALL xios_orchidee_send_field("MOISTRESS",moiavail_week)
+    CALL xios_orchidee_send_field("LEAF_M",biomass(:,:,ileaf,icarbon))
+    CALL xios_orchidee_send_field("SAP_M_AB",biomass(:,:,isapabove,icarbon))
+    CALL xios_orchidee_send_field("SAP_M_BE",biomass(:,:,isapbelow,icarbon))
+    CALL xios_orchidee_send_field("HEART_M_AB",biomass(:,:,iheartabove,icarbon))
+    CALL xios_orchidee_send_field("HEART_M_BE",biomass(:,:,iheartbelow,icarbon))
+    CALL xios_orchidee_send_field("ROOT_M",biomass(:,:,iroot,icarbon))
+    CALL xios_orchidee_send_field("FRUIT_M",biomass(:,:,ifruit,icarbon))
+    CALL xios_orchidee_send_field("RESERVE_M",biomass(:,:,icarbres,icarbon))
+    CALL xios_orchidee_send_field("TOTAL_TURN",tot_turnover)
+    CALL xios_orchidee_send_field("LEAF_TURN",turnover_daily(:,:,ileaf,icarbon))
+    CALL xios_orchidee_send_field("MAINT_RESP",resp_maint)
+    CALL xios_orchidee_send_field("GROWTH_RESP",resp_growth)
+    CALL xios_orchidee_send_field("SAP_AB_TURN",turnover_daily(:,:,isapabove,icarbon))
+    CALL xios_orchidee_send_field("ROOT_TURN",turnover_daily(:,:,iroot,icarbon))
+    CALL xios_orchidee_send_field("FRUIT_TURN",turnover_daily(:,:,ifruit,icarbon))
+    !! liulyc add total litterfall
+    CALL xios_orchidee_send_field("TOTAL_LITTERFALL",tot_litterfall(:,:,icarbon))
+
+    CALL xios_orchidee_send_field("TOTAL_BM_LITTER",tot_bm_to_litter(:,:,icarbon))
+    CALL xios_orchidee_send_field("LEAF_BM_LITTER",bm_to_litter(:,:,ileaf,icarbon))
+    CALL xios_orchidee_send_field("SAP_AB_BM_LITTER",bm_to_litter(:,:,isapabove,icarbon))
+    CALL xios_orchidee_send_field("SAP_BE_BM_LITTER",bm_to_litter(:,:,isapbelow,icarbon))
+    CALL xios_orchidee_send_field("HEART_AB_BM_LITTER",bm_to_litter(:,:,iheartabove,icarbon))
+    CALL xios_orchidee_send_field("HEART_BE_BM_LITTER",bm_to_litter(:,:,iheartbelow,icarbon))
+    CALL xios_orchidee_send_field("ROOT_BM_LITTER",bm_to_litter(:,:,iroot,icarbon))
+    CALL xios_orchidee_send_field("FRUIT_BM_LITTER",bm_to_litter(:,:,ifruit,icarbon))
+    CALL xios_orchidee_send_field("RESERVE_BM_LITTER",bm_to_litter(:,:,icarbres,icarbon))
+    CALL xios_orchidee_send_field("LITTER_STR_AB",litter(:,istructural,:,iabove,icarbon))
+    CALL xios_orchidee_send_field("LITTER_MET_AB",litter(:,imetabolic,:,iabove,icarbon))
+    CALL xios_orchidee_send_field("LITTER_STR_BE",litter(:,istructural,:,ibelow,icarbon))
+    CALL xios_orchidee_send_field("LITTER_MET_BE",litter(:,imetabolic,:,ibelow,icarbon))
+    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("CARBON_ACTIVE",carbon(:,iactive,:))
+    CALL xios_orchidee_send_field("CARBON_SLOW",carbon(:,islow,:))
+    CALL xios_orchidee_send_field("CARBON_PASSIVE",carbon(:,ipassive,:))
+    CALL xios_orchidee_send_field("LITTERHUM",litterhum_daily)
+    CALL xios_orchidee_send_field("TURNOVER_TIME",turnover_time)
+    CALL xios_orchidee_send_field("PROD10",prod10)
+    CALL xios_orchidee_send_field("FLUX10",flux10)
+    CALL xios_orchidee_send_field("PROD100",prod100)
+    CALL xios_orchidee_send_field("FLUX100",flux100)
+    CALL xios_orchidee_send_field("CONVFLUX",convflux)
+    CALL xios_orchidee_send_field("CFLUX_PROD10",cflux_prod10)
+    CALL xios_orchidee_send_field("CFLUX_PROD100",cflux_prod100)
+    CALL xios_orchidee_send_field("PROD10_HARVEST",prod10_harvest)
+    CALL xios_orchidee_send_field("FLUX10_HARVEST",flux10_harvest)
+    CALL xios_orchidee_send_field("PROD100_HARVEST",prod100_harvest)
+    CALL xios_orchidee_send_field("FLUX100_HARVEST",flux100_harvest)
+    CALL xios_orchidee_send_field("CONVFLUX_HARVEST",convflux_harvest)
+    CALL xios_orchidee_send_field("CFLUX_PROD10_HARVEST",cflux_prod10_harvest)
+    CALL xios_orchidee_send_field("CFLUX_PROD100_HARVEST",cflux_prod100_harvest)
+    IF (do_wood_harvest) THEN
+       CALL xios_orchidee_send_field("WOOD_HARVEST",woodharvest/one_year*dt_days)
+       CALL xios_orchidee_send_field("WOOD_HARVEST_PFT",woodharvestpft)
+    END IF
+    CALL xios_orchidee_send_field("HARVEST_ABOVE",harvest_above)
+    CALL xios_orchidee_send_field("VCMAX",vcmax)
+    !! liulyc
+    CALL xios_orchidee_send_field("VCMAX_CL1",vcmax_cl1)                                
+    CALL xios_orchidee_send_field("VCMAX_CL2",vcmax_cl2)                                
+    CALL xios_orchidee_send_field("VCMAX_CL3",vcmax_cl3)                                
+    CALL xios_orchidee_send_field("VCMAX_CL4",vcmax_cl4) 
+    !! liulyc above
+    CALL xios_orchidee_send_field("AGE",age)
+    CALL xios_orchidee_send_field("HEIGHT",height)
+    CALL xios_orchidee_send_field("FIREINDEX",fireindex(:,:))
+
+    ! ipcc history
+    ! Carbon stock transformed from gC/m2 into kgC/m2
+    CALL xios_orchidee_send_field("cVeg",SUM(tot_live_biomass(:,:,icarbon)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cVegGrass",sum_cVegGrass/1e3)
+    CALL xios_orchidee_send_field("cVegCrop",sum_cVegCrop/1e3)
+    CALL xios_orchidee_send_field("cVegTree",sum_cVegTree/1e3)
+    CALL xios_orchidee_send_field("cOther",SUM(cOther(:,:,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("cLitterGrass",sum_cLitterGrass/1e3)
+    CALL xios_orchidee_send_field("cLitterCrop",sum_cLitterCrop/1e3)
+    CALL xios_orchidee_send_field("cLitterTree",sum_cLitterTree/1e3)
+    CALL xios_orchidee_send_field("cSoil",SUM(tot_soil_carb*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cSoilGrass",sum_cSoilGrass/1e3)
+    CALL xios_orchidee_send_field("cSoilCrop",sum_cSoilCrop/1e3)
+    CALL xios_orchidee_send_field("cSoilTree",sum_cSoilTree/1e3)
+    CALL xios_orchidee_send_field("cProduct",(prod10_total + prod100_total + prod10_harvest_total + prod100_harvest_total)/1e3)
+
+    cproductlut(:,:)=xios_default_val
+    WHERE(fraclut(:,id_psl) > min_sechiba)
+       cproductlut(:,id_psl)= ( prod10_total + prod100_total + prod10_harvest_total + prod100_harvest_total)/1e3 &
+            / fraclut(:,id_psl)
+    ENDWHERE
+    CALL xios_orchidee_send_field("cproductlut",cproductlut)
+
+    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)
+    vartmp(:)=zero
+    DO j = 2, nvm
+       IF ( .NOT. is_tree(j) .AND. natural(j) ) THEN
+          vartmp(:) = vartmp(:) + (resp_maint(:,j)+resp_growth(:,j))*veget_cov_max(:,j)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("raGrass",vartmp/1e3/one_day)
+
+    vartmp(:)=zero
+    DO j = 2, nvm
+       IF (( .NOT. is_tree(j)) .AND. (.NOT. natural(j)) ) THEN
+          vartmp(:) = vartmp(:) + (resp_maint(:,j)+resp_growth(:,j))*veget_cov_max(:,j)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("raCrop",vartmp/1e3/one_day)
+
+    vartmp(:)=zero
+    DO j = 2, nvm
+       IF ( is_tree(j) ) THEN
+          vartmp(:) = vartmp(:) + (resp_maint(:,j)+resp_growth(:,j))*veget_cov_max(:,j)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("raTree",vartmp/1e3/one_day)
+
+    CALL xios_orchidee_send_field("npp_ipcc",SUM(npp_daily*veget_cov_max,dim=2)/1e3/one_day)
+    vartmp(:)=zero
+    DO j = 2, nvm
+       IF ( .NOT. is_tree(j) .AND. natural(j) ) THEN
+          vartmp(:) = vartmp(:) + npp_daily(:,j)*veget_cov_max(:,j)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("nppGrass",vartmp/1e3/one_day)
+
+    DO j = 2, nvm
+       IF ( (.NOT. is_tree(j)) .AND. (.NOT. natural(j)) ) THEN
+          vartmp(:) = vartmp(:) + npp_daily(:,j)*veget_cov_max(:,j)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("nppCrop",vartmp/1e3/one_day)
+
+    vartmp(:)=zero
+    DO j = 2, nvm
+       IF ( is_tree(j) ) THEN
+          vartmp(:) = vartmp(:) + npp_daily(:,j)*veget_cov_max(:,j)
+       ENDIF
+    ENDDO
+    CALL xios_orchidee_send_field("nppTree",vartmp/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)
+    ctotfirelut(:,:)=xios_default_val
+    WHERE(fraclut(:,id_psl) > min_sechiba)  
+       ctotfirelut(:,id_psl)= SUM(co2_fire*veget_cov_max,dim=2)/1e3/one_day &
+            / fraclut(:,id_psl)
+    ENDWHERE
+    CALL xios_orchidee_send_field("ctotfirelut",ctotfirelut)
+
+    CALL xios_orchidee_send_field("fHarvest",harvest_above/1e3/one_day)
+    Call xios_orchidee_send_field("fLuc",cflux_prod_total/1e3/one_day)
+    CALL xios_orchidee_send_field("fWoodharvest",cflux_prod_harvest_total/1e3/one_day)
+    CALL xios_orchidee_send_field("fDeforestToProduct",SUM((fDeforestToProduct-convfluxpft),dim=2)/1e3/one_day)
+    
+    flulccproductlut(:,:)=xios_default_val
+    flulccproductlut(:,id_psl)=0.
+    flulccproductlut(:,id_crp)=0.
+    DO j=1,nvm
+       IF(natural(j)) THEN
+          flulccproductlut(:,id_psl)=flulccproductlut(:,id_psl) + fDeforestToProduct(:,j)
+       ELSE
+          flulccproductlut(:,id_crp)=flulccproductlut(:,id_crp) + fDeforestToProduct(:,j)
+       ENDIF
+    ENDDO
+
+    WHERE(fraclut(:,id_psl) > min_sechiba)
+       flulccproductlut(:,id_psl)= (flulccproductlut(:,id_psl) &
+            +SUM(fHarvestToProduct,dim=2)) &
+            /1e3/one_day / fraclut(:,id_psl)
+    ELSEWHERE
+       flulccproductlut(:,id_psl)= xios_default_val
+    ENDWHERE
+    WHERE(fraclut(:,id_crp) > min_sechiba)
+       flulccproductlut(:,id_crp)= flulccproductlut(:,id_crp) &
+            /1e3/one_day / fraclut(:,id_crp)
+    ELSEWHERE
+       flulccproductlut(:,id_crp)= xios_default_val
+    ENDWHERE
+    CALL xios_orchidee_send_field("flulccproductlut",flulccproductlut)
+
+    flulccresiduelut(:,:)=xios_default_val
+    flulccresiduelut(:,id_psl)=0.
+    flulccresiduelut(:,id_crp)=0.
+    DO j=1,nvm
+       IF(natural(j)) THEN
+          flulccresiduelut(:,id_psl) = flulccresiduelut(:,id_psl) + fLulccResidue(:,j)
+       ELSE
+          flulccresiduelut(:,id_crp) = flulccresiduelut(:,id_crp) + fLulccResidue(:,j)
+       ENDIF
+    ENDDO
+
+    WHERE(fraclut(:,id_psl) > min_sechiba)
+       flulccresiduelut(:,id_psl)= flulccresiduelut(:,id_psl)/1e3/one_day/fraclut(:,id_psl)
+    ELSEWHERE
+       flulccresiduelut(:,id_psl)= xios_default_val
+    ENDWHERE
+    WHERE(fraclut(:,id_crp) > min_sechiba)
+       flulccresiduelut(:,id_crp)= flulccresiduelut(:,id_crp)/1e3/one_day /fraclut(:,id_crp)
+    ELSEWHERE
+       flulccresiduelut(:,id_crp)= xios_default_val
+    ENDWHERE
+    CALL xios_orchidee_send_field("flulccresiduelut",flulccresiduelut)
+    CALL xios_orchidee_send_field("flulccresidue",flulccresidue)
+
+    flulccatmlut(:,:)=xios_default_val
+    flulccatmlut(:,id_psl)=0.
+    flulccatmlut(:,id_crp)=0.
+    DO j=1,nvm
+       IF(natural(j)) THEN
+          flulccatmlut(:,id_psl)=flulccatmlut(:,id_psl)+convfluxpft(:,j)
+       ELSE
+          flulccatmlut(:,id_crp)=flulccatmlut(:,id_crp)+convfluxpft(:,j)
+       ENDIF
+    ENDDO
+
+    WHERE(fraclut(:,id_psl) > min_sechiba)
+       flulccatmlut(:,id_psl)= (flulccatmlut(:,id_psl)+cflux_prod10+cflux_prod100+cflux_prod_harvest_total) &
+            /1e3/one_day / fraclut(:,id_psl)
+    ELSEWHERE
+       flulccatmlut(:,id_psl)= xios_default_val
+    ENDWHERE
+    WHERE(fraclut(:,id_crp) > min_sechiba)
+       flulccatmlut(:,id_crp)= (flulccatmlut(:,id_crp)+harvest_above)/1e3/one_day / fraclut(:,id_crp)
+    ELSEWHERE
+       flulccatmlut(:,id_crp)= xios_default_val
+    ENDWHERE
+    CALL xios_orchidee_send_field("flulccatmlut",flulccatmlut)
+
+   ! co2_to_bm is not added as it is already included in gpp
+    CALL xios_orchidee_send_field("nbp",(SUM((gpp_daily-(resp_maint+resp_growth+resp_hetero)-co2_fire) * &
+          veget_cov_max,dim=2)-cflux_prod_total-cflux_prod_harvest_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(soilcarbon_input,dim=2)*veget_cov_max,dim=2)/1e3/one_day)
+
+    ! Carbon stock transformed from gC/m2 into kgC/m2
+    CALL xios_orchidee_send_field("cLeaf",SUM(biomass(:,:,ileaf,icarbon)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cStem",SUM((biomass(:,:,isapabove,icarbon)+biomass(:,:,iheartabove,icarbon))*&
+          veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cWood",SUM((biomass(:,:,isapabove,icarbon)+biomass(:,:,iheartabove,icarbon) + &
+         biomass(:,:,isapbelow,icarbon) + biomass(:,:,iheartbelow,icarbon))* &
+         veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cRoot",SUM(( biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon) + &
+         biomass(:,:,iheartbelow,icarbon) )*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cMisc",SUM(( biomass(:,:,icarbres,icarbon) + biomass(:,:,ifruit,icarbon))*&
+         veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cLitterAbove",SUM((litter(:,istructural,:,iabove,icarbon)+&
+         litter(:,imetabolic,:,iabove,icarbon))*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cLitterBelow",SUM((litter(:,istructural,:,ibelow,icarbon)+&
+         litter(:,imetabolic,:,ibelow,icarbon))*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cSoilFast",SUM(carbon(:,iactive,:)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cSoilMedium",SUM(carbon(:,islow,:)*veget_cov_max,dim=2)/1e3)
+    CALL xios_orchidee_send_field("cSoilSlow",SUM(carbon(:,ipassive,:)*veget_cov_max,dim=2)/1e3)
+
+    DO k = 1, ncarb
+       csoilpools(:,k) = SUM(carbon(:,k,:)*veget_cov_max,dim=2)/1e3
+    END DO
+    CALL xios_orchidee_send_field("cSoilPools",csoilpools)
+
+    ! Vegetation fractions [0,100]
+    CALL xios_orchidee_send_field("landCoverFrac",veget_cov_max*100)
+
+    ! 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)
+    ! nppStem : from wood above surface
+    CALL xios_orchidee_send_field("nppStem",SUM((bm_alloc(:,:,isapabove,icarbon) + bm_alloc(:,:,iheartabove,icarbon)) &
+         *veget_cov_max,dim=2)/1e3/one_day)
+    ! nppWood : from wood above and below surface 
+    CALL xios_orchidee_send_field("nppWood",SUM((bm_alloc(:,:,isapabove,icarbon) + bm_alloc(:,:,iheartabove,icarbon) + &
+         bm_alloc(:,:,isapbelow,icarbon) + bm_alloc(:,:,iheartbelow,icarbon)) &
+         *veget_cov_max,dim=2)/1e3/one_day)
+    ! nppRoot : from wood below surface and fine roots
+    CALL xios_orchidee_send_field("nppRoot",SUM((bm_alloc(:,:,isapbelow,icarbon) + bm_alloc(:,:,iheartbelow,icarbon) + &
+         bm_alloc(:,:,iroot,icarbon)) * veget_cov_max,dim=2)/1e3/one_day)
+    CALL xios_orchidee_send_field("nppOther",SUM(( bm_alloc(:,:,ifruit,icarbon) + bm_alloc(:,:,icarbres,icarbon) ) * &
+         veget_cov_max,dim=2)/1e3/one_day)
+
+    ! Calculate variables according to LUMIP specifications. 
+    clitterlut(:,:) = 0 
+    csoillut(:,:) = 0 
+    cveglut(:,:) = 0
+    lailut(:,:) = 0
+    ralut(:,:) = 0
+    rhlut(:,:) = 0
+    npplut(:,:) = 0
+
+    DO j=1,nvm
+       IF (natural(j)) THEN
+          clitterlut(:,id_psl) = clitterlut(:,id_psl) + tot_litter_carb(:,j)*veget_cov_max(:,j)/1e3
+          csoillut(:,id_psl) = csoillut(:,id_psl) + tot_soil_carb(:,j)*veget_cov_max(:,j)/1e3
+          cveglut(:,id_psl) = cveglut(:,id_psl) + tot_live_biomass(:,j,icarbon)*veget_cov_max(:,j)/1e3
+          lailut(:,id_psl) = lailut(:,id_psl) + lai(:,j)*veget_cov_max(:,j)
+          ralut(:,id_psl) = ralut(:,id_psl) + &
+               (resp_maint(:,j)+resp_growth(:,j))*veget_cov_max(:,j)/1e3/one_day
+          rhlut(:,id_psl) = rhlut(:,id_psl) + &
+               resp_hetero(:,j)*veget_cov_max(:,j)/1e3/one_day
+          npplut(:,id_psl) = npplut(:,id_psl) + &
+               npp_daily(:,j)*veget_cov_max(:,j)/1e3/one_day
+       ELSE
+          clitterlut(:,id_crp) = clitterlut(:,id_crp) + tot_litter_carb(:,j)*veget_cov_max(:,j)/1e3
+          csoillut(:,id_crp) = csoillut(:,id_crp) + tot_soil_carb(:,j)*veget_cov_max(:,j)/1e3
+          cveglut(:,id_crp) = cveglut(:,id_crp) + tot_live_biomass(:,j,icarbon)*veget_cov_max(:,j)/1e3
+          lailut(:,id_crp) = lailut(:,id_crp) + lai(:,j)*veget_cov_max(:,j)
+          ralut(:,id_crp) = ralut(:,id_crp) + &
+               (resp_maint(:,j)+resp_growth(:,j))*veget_cov_max(:,j)/1e3/one_day
+          rhlut(:,id_crp) = rhlut(:,id_crp) + &
+               resp_hetero(:,j)*veget_cov_max(:,j)/1e3/one_day
+          npplut(:,id_crp) = npplut(:,id_crp) + &
+               npp_daily(:,j)*veget_cov_max(:,j)/1e3/one_day
+       END IF
+    END DO
+
+    WHERE (fraclut(:,id_psl)>min_sechiba)
+       clitterlut(:,id_psl) = clitterlut(:,id_psl)/fraclut(:,id_psl)
+       csoillut(:,id_psl) = csoillut(:,id_psl)/fraclut(:,id_psl)
+       cveglut(:,id_psl) = cveglut(:,id_psl)/fraclut(:,id_psl)
+       lailut(:,id_psl) = lailut(:,id_psl)/fraclut(:,id_psl)
+       ralut(:,id_psl) = ralut(:,id_psl)/fraclut(:,id_psl)
+       rhlut(:,id_psl) = rhlut(:,id_psl)/fraclut(:,id_psl)
+       npplut(:,id_psl) = npplut(:,id_psl)/fraclut(:,id_psl)
+    ELSEWHERE
+       clitterlut(:,id_psl) = xios_default_val
+       csoillut(:,id_psl) = xios_default_val
+       cveglut(:,id_psl) = xios_default_val
+       lailut(:,id_psl) = xios_default_val
+       ralut(:,id_psl) = xios_default_val
+       rhlut(:,id_psl) = xios_default_val
+       npplut(:,id_psl) = xios_default_val
+    END WHERE
+
+    WHERE (fraclut(:,id_crp)>min_sechiba)
+       clitterlut(:,id_crp) = clitterlut(:,id_crp)/fraclut(:,id_crp)
+       csoillut(:,id_crp) = csoillut(:,id_crp)/fraclut(:,id_crp)
+       cveglut(:,id_crp) = cveglut(:,id_crp)/fraclut(:,id_crp)
+       lailut(:,id_crp) = lailut(:,id_crp)/fraclut(:,id_crp)
+       ralut(:,id_crp) = ralut(:,id_crp)/fraclut(:,id_crp)
+       rhlut(:,id_crp) = rhlut(:,id_crp)/fraclut(:,id_crp)
+       npplut(:,id_crp) = npplut(:,id_crp)/fraclut(:,id_crp)
+    ELSEWHERE
+       clitterlut(:,id_crp) = xios_default_val
+       csoillut(:,id_crp) = xios_default_val
+       cveglut(:,id_crp) = xios_default_val
+       lailut(:,id_crp) = xios_default_val
+       ralut(:,id_crp) = xios_default_val
+       rhlut(:,id_crp) = xios_default_val
+       npplut(:,id_crp) = xios_default_val
+    END WHERE
+
+    clitterlut(:,id_pst) = xios_default_val
+    clitterlut(:,id_urb) = xios_default_val
+    csoillut(:,id_pst)   = xios_default_val
+    csoillut(:,id_urb)   = xios_default_val
+    cveglut(:,id_pst)    = xios_default_val
+    cveglut(:,id_urb)    = xios_default_val
+    lailut(:,id_pst)     = xios_default_val
+    lailut(:,id_urb)     = xios_default_val
+    ralut(:,id_pst)      = xios_default_val
+    ralut(:,id_urb)      = xios_default_val
+    rhlut(:,id_pst)      = xios_default_val
+    rhlut(:,id_urb)      = xios_default_val
+    npplut(:,id_pst)     = xios_default_val
+    npplut(:,id_urb)     = xios_default_val
+
+    CALL xios_orchidee_send_field("clitterlut",clitterlut)
+    CALL xios_orchidee_send_field("csoillut",csoillut)
+    CALL xios_orchidee_send_field("cveglut",cveglut)
+    CALL xios_orchidee_send_field("lailut",lailut)
+    CALL xios_orchidee_send_field("ralut",ralut)
+    CALL xios_orchidee_send_field("rhlut",rhlut)
+    CALL xios_orchidee_send_field("npplut",npplut)
+
+    CALL histwrite_p (hist_id_stomate, 'RESOLUTION_X', itime, &
+         resolution(:,1), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'RESOLUTION_Y', itime, &
+         resolution(:,2), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CONTFRAC', itime, &
+         contfrac(:), npts, hori_index)
+
+    CALL histwrite_p (hist_id_stomate, 'LITTER_STR_AB', itime, &
+         litter(:,istructural,:,iabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTER_MET_AB', itime, &
+         litter(:,imetabolic,:,iabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTER_STR_BE', itime, &
+         litter(:,istructural,:,ibelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTER_MET_BE', itime, &
+         litter(:,imetabolic,:,ibelow,icarbon), npts*nvm, horipft_index)
+
+    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)
+    CALL histwrite_p (hist_id_stomate, 'CARBON_ACTIVE', itime, &
+         carbon(:,iactive,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CARBON_SLOW', itime, &
+         carbon(:,islow,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CARBON_PASSIVE', itime, &
+         carbon(:,ipassive,:), npts*nvm, horipft_index)
+
+    CALL histwrite_p (hist_id_stomate, 'T2M_MONTH', itime, &
+         t2m_month, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'T2M_WEEK', itime, &
+         t2m_week, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TSEASON', itime, &
+         Tseason, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TMIN_SPRING_TIME', itime, &
+         Tmin_spring_time, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ONSET_DATE', itime, &
+         onset_date(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FPC_MAX', itime, &
+         fpc_max, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MAXFPC_LASTYEAR', itime, &
+         maxfpc_lastyear, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HET_RESP', itime, &
+         resp_hetero(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FIREINDEX', itime, &
+         fireindex(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTERHUM', itime, &
+         litterhum_daily, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CO2_FIRE', itime, &
+         co2_fire, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CO2_TAKEN', itime, &
+         co2_to_bm, npts*nvm, horipft_index)
+    ! land cover change
+    CALL histwrite_p (hist_id_stomate, 'CONVFLUX', itime, &
+         convflux, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CFLUX_PROD10', itime, &
+         cflux_prod10, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CFLUX_PROD100', itime, &
+         cflux_prod100, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CONVFLUX_HARVEST', itime, &
+         convflux_harvest, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CFLUX_PROD10_HARVEST', itime, &
+         cflux_prod10_harvest, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CFLUX_PROD100_HARVES', itime, &
+         cflux_prod100_harvest, npts, hori_index)
+
+    IF (do_wood_harvest) THEN
+       CALL histwrite_p (hist_id_stomate, 'WOOD_HARVEST', itime, &
+            woodharvest/one_year*dt_days, npts, hori_index)
+       CALL histwrite_p (hist_id_stomate, 'WOOD_HARVEST_PFT', itime, &
+            woodharvestpft, npts*nvm, horipft_index)
+    END IF
+
+    CALL histwrite_p (hist_id_stomate, 'HARVEST_ABOVE', itime, &
+         harvest_above, npts, hori_index)
+
+    CALL histwrite_p (hist_id_stomate, 'LAI', itime, &
+         lai, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'VEGET_COV_MAX', itime, &
+         veget_cov_max, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NPP', itime, &
+         npp_daily, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GPP', itime, &
+         gpp_daily, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'IND', itime, &
+         ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CN_IND', itime, &
+         cn_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'WOODMASS_IND', itime, &
+         woodmass_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_M', itime, &
+         tot_live_biomass(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_M', itime, &
+         biomass(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_M_AB', itime, &
+         biomass(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_M_BE', itime, &
+         biomass(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_M_AB', itime, &
+         biomass(:,:,iheartabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_M_BE', itime, &
+         biomass(:,:,iheartbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_M', itime, &
+         biomass(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_M', itime, &
+         biomass(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RESERVE_M', itime, &
+         biomass(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_TURN', itime, &
+         tot_turnover(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_TURN', itime, &
+         turnover_daily(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_AB_TURN', itime, &
+         turnover_daily(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_TURN', itime, &
+         turnover_daily(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_TURN', itime, &
+         turnover_daily(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_BM_LITTER', itime, &
+         tot_bm_to_litter(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_BM_LITTER', itime, &
+         bm_to_litter(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_AB_BM_LITTER', itime, &
+         bm_to_litter(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_BE_BM_LITTER', itime, &
+         bm_to_litter(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_AB_BM_LITTER', itime, &
+         bm_to_litter(:,:,iheartabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_BE_BM_LITTER', itime, &
+         bm_to_litter(:,:,iheartbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_BM_LITTER', itime, &
+         bm_to_litter(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_BM_LITTER', itime, &
+         bm_to_litter(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RESERVE_BM_LITTER', itime, &
+         bm_to_litter(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MAINT_RESP', itime, &
+         resp_maint, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GROWTH_RESP', itime, &
+         resp_growth, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AGE', itime, &
+         age, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEIGHT', itime, &
+         height, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MOISTRESS', itime, &
+         moiavail_week, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'VCMAX', itime, &
+         vcmax, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TURNOVER_TIME', itime, &
+         turnover_time, npts*nvm, horipft_index)
+    ! land cover change
+    CALL histwrite_p (hist_id_stomate, 'PROD10', itime, &
+         prod10, npts*11, horip11_index)
+    CALL histwrite_p (hist_id_stomate, 'PROD100', itime, &
+         prod100, npts*101, horip101_index)
+    CALL histwrite_p (hist_id_stomate, 'FLUX10', itime, &
+         flux10, npts*10, horip10_index)
+    CALL histwrite_p (hist_id_stomate, 'FLUX100', itime, &
+         flux100, npts*100, horip100_index)
+    CALL histwrite_p (hist_id_stomate, 'PROD10_HARVEST', itime, &
+         prod10_harvest, npts*11, horip11_index)
+    CALL histwrite_p (hist_id_stomate, 'PROD100_HARVEST', itime, &
+         prod100_harvest, npts*101, horip101_index)
+    CALL histwrite_p (hist_id_stomate, 'FLUX10_HARVEST', itime, &
+         flux10_harvest, npts*10, horip10_index)
+    CALL histwrite_p (hist_id_stomate, 'FLUX100_HARVEST', itime, &
+         flux100_harvest, npts*100, horip100_index)
+
+    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 + prod10_harvest_total + prod100_harvest_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(:)=cflux_prod_harvest_total/1e3/one_day
+       CALL histwrite_p (hist_id_stomate_IPCC, "fWoodharvest", itime, &
+            vartmp, npts, hori_index)
+       ! co2_to_bm is not added as it is already included in gpp
+       vartmp(:)=(SUM((gpp_daily-(resp_maint+resp_growth+resp_hetero)-co2_fire) &
+            &        *veget_cov_max,dim=2)-cflux_prod_total-cflux_prod_harvest_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(soilcarbon_input,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(biomass(:,:,ileaf,icarbon)*veget_cov_max,dim=2)/1e3
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLeaf", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((biomass(:,:,isapabove,icarbon)+biomass(:,:,iheartabove,icarbon))*veget_cov_max,dim=2)/1e3
+       CALL histwrite_p (hist_id_stomate_IPCC, "cStem", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon) + biomass(:,:,iheartbelow,icarbon) ) &
+            &        *veget_cov_max,dim=2)/1e3
+       CALL histwrite_p (hist_id_stomate_IPCC, "cRoot", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( biomass(:,:,icarbres,icarbon) + biomass(:,:,ifruit,icarbon))*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))*&
+            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))*&
+            veget_cov_max,dim=2)/1e3
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLitterBelow", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(carbon(:,iactive,:)*veget_cov_max,dim=2)/1e3
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoilFast", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(carbon(:,islow,:)*veget_cov_max,dim=2)/1e3
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoilMedium", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(carbon(:,ipassive,:)*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) + bm_alloc(:,:,iheartabove,icarbon))*veget_cov_max,dim=2)/1e3/one_day
+       CALL histwrite_p (hist_id_stomate_IPCC, "nppStem", 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>=4) WRITE(numout,*) 'Leaving stomate_lpj'
+
+  END SUBROUTINE StomateLpj
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : harvest
+!!
+!>\BRIEF        Harvest of croplands
+!!
+!! DESCRIPTION  : To take into account biomass harvest from crop (mainly to take 
+!! into account for the reduced litter input and then decreased soil carbon. it is a 
+!! constant (40\%) fraction of above ground biomass.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::harvest_above the harvested biomass
+!!
+!! REFERENCE(S) :
+!! - Piao, S., P. Ciais, P. Friedlingstein, N. de Noblet-Ducoudre, P. Cadule, N. Viovy, and T. Wang. 2009. 
+!!   Spatiotemporal patterns of terrestrial carbon cycle during the 20th century. Global Biogeochemical 
+!!   Cycles 23:doi:10.1029/2008GB003339.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE harvest(npts, dt_days, veget_cov_max, &
+       bm_to_litter, turnover_daily, &
+       harvest_above)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                    :: npts            !! Domain size (unitless) 
+    REAL(r_std), INTENT(in)                                :: dt_days         !! Time step (days)                               
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_cov_max       !! new "maximal" coverage fraction of a PFT (LAI -> 
+                                                                              !! infinity) on ground @tex $(m^2 m^{-2})$ @endtex 
+    
+   !! 0.2 Output variables
+   
+   !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! [DISPENSABLE] conversion of biomass to litter 
+                                                                                     !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_daily   !! Turnover rates 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: harvest_above    !! harvest above ground biomass for agriculture 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                         :: i, j, k, l, m    !! indices                       
+    REAL(r_std)                                            :: above_old        !! biomass of previous time step 
+                                                                               !! @tex $(gC m^{-2})$ @endtex 
+!_ ================================================================================================================================
+
+  !! 1. Yearly initialisation
+
+    above_old             = zero
+    harvest_above         = zero
+
+    DO i = 1, npts
+       DO j = 1,nvm
+          IF (.NOT. natural(j)) THEN
+             above_old = turnover_daily(i,j,ileaf,icarbon) + turnover_daily(i,j,isapabove,icarbon) + &
+                  &       turnover_daily(i,j,iheartabove,icarbon) + turnover_daily(i,j,ifruit,icarbon) + &
+                  &       turnover_daily(i,j,icarbres,icarbon) + turnover_daily(i,j,isapbelow,icarbon) + &
+                  &       turnover_daily(i,j,iheartbelow,icarbon) + turnover_daily(i,j,iroot,icarbon)
+
+             turnover_daily(i,j,ileaf,icarbon) = turnover_daily(i,j,ileaf,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,isapabove,icarbon) = turnover_daily(i,j,isapabove,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,isapbelow,icarbon) = turnover_daily(i,j,isapbelow,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iheartabove,icarbon) = turnover_daily(i,j,iheartabove,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iheartbelow,icarbon) = turnover_daily(i,j,iheartbelow,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iroot,icarbon) = turnover_daily(i,j,iroot,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,ifruit,icarbon) = turnover_daily(i,j,ifruit,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,icarbres,icarbon) = turnover_daily(i,j,icarbres,icarbon)*frac_turnover_daily
+             harvest_above(i)  = harvest_above(i) + veget_cov_max(i,j) * above_old *(un - frac_turnover_daily)
+          ENDIF
+       ENDDO
+    ENDDO
+
+!!$    harvest_above = harvest_above
+  END SUBROUTINE harvest
+END MODULE stomate_lpj
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_npp.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_npp.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_npp.f90	(revision 8430)
@@ -0,0 +1,557 @@
+! =================================================================================================================================
+! MODULE          : stomate_npp
+!
+! CONTACT         : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE         : IPSL (2006)
+!                 This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          This modules calculates NPP: Maintenance and growth respiration
+!!
+!!\n DESCRIPTION: We calculate first the maintenance respiration. This is substracted from the
+!!                allocatable biomass (and from the present biomass if the GPP is too low).\n
+!!                Of the rest, a part is lost as growth respiration, while the other part is
+!!                effectively allocated.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_npp
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC npp_calc,npp_calc_clear
+
+  LOGICAL, SAVE                                              :: firstcall_npp = .TRUE.         !! first call
+!$OMP THREADPRIVATE(firstcall_npp)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: npp_calc_clear
+!!
+!>\BRIEF        : Set the flag ::firstcall_npp to .TRUE. and as such activate section 
+!! 1.1 of the subroutine npp_calc (see below).\n
+!_ ================================================================================================================================
+
+  SUBROUTINE npp_calc_clear
+    firstcall_npp=.TRUE.
+  END SUBROUTINE npp_calc_clear
+
+
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: npp_calc
+!!
+!>\BRIEF        Calculate NPP as the difference between GPP and respiration (= growth + maintenance respiration).
+!!              Update biomass of all compartments after calculating respiration and allocation.
+!!
+!!
+!! DESCRIPTION  : NPP is calculated from three components: Gross Primary Productivity (GPP), maintenance respiration 
+!! and growth respiration (all in @tex $ gC.m^{-2}dt^{-1} $ @endtex), following the convention that positive fluxes denote 
+!! fluxes plants to the atmosphere. GPP is the input variable from which, in the end, NPP or total allocatable biomass 
+!! @tex $(gC.m^{-2}dt^{-1}))$ @endtex is calculated. Net primary production is then calculated as:\n	
+!! NPP = GPP - growth_resp - maint-resp   [eq. 1]\n   
+!!	
+!! The calculation of maintenance respiration is done in routine stomate_resp.f90. Maintenance respiration is calculated for 
+!! the whole plant and is therefore removed from the total allocatable biomass. In order to prevent all allocatable biomass 
+!! from being used for maintenance respiration, a limit fraction of total allocatable biomass, tax_max, is defined (in 
+!! variables declaration). If maintenance respiration exceeds tax_max (::bm_tax_max), the maximum allowed allocatable biomass
+!! will be respired and the remaining respiration, required in excess of tax_max, is taken out from tissues already present in
+!! the plant (biomass).\n  
+!! 
+!! After total allocatable biomass has been updated by removing maintenance respiration, total allocatable biomass is distributed 
+!! to all plant compartments according to the f_alloc fractions calculated in stomate_alloc.f90.\n
+!!
+!! Growth respiration is calculated as a fraction of allocatable biomass for each part of the plant. The fraction coefficient 
+!! ::frac_growth_resp is defined in stomate_constants.f90 and is currently set to be the same for all plant compartments. 
+!! Allocatable biomass of all plant compartments are updated by removing what is lost through growth respiration. Net allocatable
+!! biomass (total allocatable biomass after maintenance and growth respiration) is added to the current biomass for  each plant 
+!! compartment.
+!!
+!! Finally, leaf age and plant age are updated. Leaf age is described with the concept of "leaf age classes". A number of leaf 
+!! age classes (nleafages) is defined in stomate_constants.f90. Each leaf age class contains a fraction (::leaf_frac) of the 
+!! total leaf biomass. When new biomass is added to leaves, the age of the biomass in the youngest leaf age class is decreased. 
+!! The fractions of leaves in the other leaf ages classes are also updated as the total biomass has increased. Plant age is 
+!! updated first by increasing the age of the previous biomass by one time step, and then by adjusting this age as the average 
+!! of the ages of the previous and the new biomass.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::npp
+!!
+!! REFERENCE(S)	: 
+!! - F.W.T.Penning De Vries, A.H.M. Brunsting, H.H. Van Laar. 1974. Products, requirements and efficiency of biosynthesis a 
+!! quantitative approach. Journal of Theoretical Biology, Volume 45, Issue 2, June 1974, Pages 339-377.
+!! 
+!! FLOWCHART : 
+!! \latexonly
+!! \includegraphics[scale=0.14]{stomate_npp_flow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE npp_calc (npts, dt, &
+       PFTpresent, &
+       t2m, tsoil, lai, rprof, &
+
+      !!@xchen lai for leaf age class1-4 for caculating PC in Wu's science paper
+       lai_cl1, lai_cl2, lai_cl3,lai_cl4,delta_turnover, var_date, &
+      !! liuly above
+       gpp, f_alloc, bm_alloc, resp_maint_part,&
+       biomass, leaf_age, leaf_frac, age, &
+       resp_maint, resp_growth, npp, co2_to_bm)
+   
+!! 0 Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                                   :: dt               !! Time step (days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: PFTpresent       !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: t2m              !! Temperature at 2 meter (K)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)             :: tsoil            !! Soil temperature of each soil layer (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai              !! PFT leaf area index (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: rprof            !! PFT root depth as calculated in stomate.f90
+                                                                                  !! from root profile parameter humcste (m) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: gpp              !! PFT gross primary productivity 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)       :: f_alloc          !! Fraction of total allocatable biomass that 
+                                                                                  !! goes into each plant part (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)       :: resp_maint_part  !! Maintenance respiration of different plant 
+                                                                                  !! parts @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: resp_maint       !! PFT maintenance respiration 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: resp_growth      !! PFT growth respiration 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex				
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: npp              !! PFT net primary productivity 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: bm_alloc    !! PFT biomass increase, i.e. NPP per plant part 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+!! xchen
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: lai_cl1          !! @xchen to add lai of each leaf class age and for                                                                                  !!calculating PC in wu's science paper
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: lai_cl2
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: lai_cl3        
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: lai_cl4        
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: delta_turnover   !! Intermediate variable for turnover ??
+    INTEGER(i_std),INTENT(in)                                 :: var_date         !! xchen Date (days) 
+!! liuly above
+
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass   !! PFT total biomass of each plant part 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age         !! PFT age of different leaf age classes (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac        !! PFT fraction of total leaves in leaf age 
+                                                                                  !! class (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age              !! PFT age (years)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm        !! virtual gpp @tex $(gC.m^{-2})$ @endtex
+
+    !! 0.4 Local variables
+!! liulyc
+!!    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)       :: sla_age1 !!? how to use? seems useless 2 3 4
+    REAL(r_std), DIMENSION(npts,nvm)                      :: sla_age2
+    REAL(r_std), DIMENSION(npts,nvm)                      :: sla_age3
+    REAL(r_std), DIMENSION(npts,nvm)                      :: sla_age4 
+!! liulyc above
+
+    REAL(r_std), DIMENSION(npts,nvm)                          :: t_root           !! Root temperature (convolution of root and 
+                                                                                  !! soil temperature profiles)(K)
+    REAL(r_std), DIMENSION(npts,nvm,nparts)                   :: coeff_maint      !! PFT maintenance respiration coefficients of 
+                                                                                  !! different plant compartments at 0 deg C 
+                                                                                  !! @tex $(g.g^{-1}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nparts)                       :: t_maint          !! Temperature which is pertinent for maintenance
+                                                                                  !! respiration, which is air/root temperature for
+                                                                                  !! above/below-ground compartments (K)
+    REAL(r_std), DIMENSION(npts)                              :: rpc              !! Scaling factor for integrating vertical soil 
+                                                                                  !! profiles (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: tl               !! Long term annual mean temperature (C)
+    REAL(r_std), DIMENSION(npts)                              :: slope            !! Slope of maintenance respiration coefficient
+                                                                                  !! (1/K)
+    REAL(r_std), DIMENSION(npts,nparts)                       :: resp_growth_part !! Growth respiration of different plant parts
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm)                          :: bm_alloc_tot     !! Allocatable biomass for the whole plant
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                              :: bm_add           !! Biomass increase @tex $(gC.m^{-2})$ @endtex		
+    REAL(r_std), DIMENSION(npts)                              :: bm_new           !! New biomass @tex $(gC.m^{-2})$ @endtex	
+    REAL(r_std), DIMENSION(npts,nvm)                          :: leaf_mass_young  !! Leaf mass in youngest age class 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm)                          :: lm_old           !! Leaf mass after maintenance respiration 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex			
+    REAL(r_std), DIMENSION(npts,nvm)                          :: bm_create        !! Biomass created when biomass<0 because of dark
+                                                                                  !! respiration @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                              :: bm_tax_max       !! Maximum part of allocatable biomass used for 
+                                                                                  !! respiration @tex $(gC.m^{-2})$ @endtex	
+    REAL(r_std), DIMENSION(npts)                              :: bm_pump          !! Biomass that remains to be taken away 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    INTEGER(i_std)                                            :: i,j,k,l,m        !! Indeces(unitless)
+    INTEGER(i_std)                                            :: ier              !! Error handling
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering npp'
+    
+ !! 1. Initializations
+    
+    !! 1.1 First call
+    IF ( firstcall_npp ) THEN
+
+       !! 1.1.2 Output message
+       !  Write message including value used for tax_max 	
+       IF (printlev >= 2) THEN
+          WRITE(numout,*) 'npp:'
+
+          WRITE(numout,*) '   > max. fraction of allocatable biomass used for'// &
+               ' maint. resp.:', tax_max
+       END IF
+       firstcall_npp = .FALSE.
+
+    ENDIF ! End if first call
+
+    !! 1.2 Set output variables to zero
+    bm_alloc(:,:,:,:) = zero
+    resp_maint(:,:) = zero
+    resp_growth(:,:) = zero
+    npp(:,:) = zero
+
+    !!@xchen
+    lai_cl1(:,:) = zero
+    lai_cl2(:,:) = zero                                                       
+    lai_cl3(:,:) = zero                                                       
+    lai_cl4(:,:) = zero     
+
+    !! 1.3 Total allocatable biomass
+    ! total allocatable biomass during this time step determined from GPP.
+    ! GPP was calculated as CO2 assimilation in enerbil.f90
+
+    !!liulya xchen mod here but with same expression in IF and else?
+    bm_alloc_tot(:,:) = gpp(:,:) * dt
+
+    
+ 
+    !! 3. Calculate maintenance and growth respiration
+    ! First, total maintenance respiration for the whole plant is calculated by summing maintenance 
+    ! respiration of the different plant compartments. Then, maintenance respiration is subtracted 
+    ! from whole-plant allocatable biomass (up to a maximum fraction of the total allocatable biomass). 
+    ! Growth respiration is then calculated for each plant compartment as a fraction of remaining 
+    ! allocatable biomass for this compartment. NPP is calculated by substracting total autotrophic 
+    ! respiration from GPP i.e. NPP = GPP - maintenance resp - growth resp.
+    DO j = 2,nvm	! Loop over # of PFTs
+
+       !! 3.1 Maintenance respiration of the different plant parts
+       !      Maintenance respiration of the different plant parts is calculated in 
+       !      stomate_resp.f90 as a function of the plant's temperature, 
+       !      the long term temperature and plant coefficients 
+       !      VPP killer:
+       resp_maint(:,j) = zero
+
+       !  Following the calculation of hourly maintenance respiration, verify that 
+       !  the PFT has not been killed after calcul of resp_maint_part in stomate.
+       DO k= 1, nparts
+          WHERE (PFTpresent(:,j))
+             resp_maint(:,j) = resp_maint(:,j) + resp_maint_part(:,j,k)
+          ENDWHERE
+       ENDDO
+       
+       !! 3.2 Substract maintenance respiration from allocatable biomass
+       !      The total maintenance respiration calculated in 3.2 is substracted  from the newly 
+       !      produced allocatable biomass (bm_alloc_tot). However, ensure that not all allocatable 
+       !      biomass is removed by setting a maximum to the fraction of allocatable biomass used 
+       !      for maintenance respiration: tax_max. If the maintenance respiration is larger than 
+       !      tax_max,the amount tax_max is taken from allocatable biomass, and the remaining of 
+       !      maintenance respiration is taken from the tissues themselves (biomass). We suppose 
+       !      that respiration is not dependent on leaf age -> therefore the leaf age structure is 
+       !      not changed. 
+       !      The maximum fraction of allocatable biomass used for respiration is defined as tax_max. 
+       !      The value of tax_max is set in the declarations section (0.4 Local variables) of this
+       !      routine
+       bm_tax_max(:) = tax_max * bm_alloc_tot(:,j)
+
+       DO i = 1, npts	! Loop over # of pixels
+
+          ! If there is enough allocatable biomass to cover maintenance respiration, 
+	  ! then biomass associated with maintenance respiration is removed from allocatable biomass
+          IF ( bm_alloc_tot(i,j) .GT. zero ) THEN
+               IF ( ( resp_maint(i,j) * dt ) .LT. bm_tax_max(i) )  THEN	
+	
+                  bm_alloc_tot(i,j) = bm_alloc_tot(i,j) - resp_maint(i,j) * dt
+
+                  ! If there is not enough allocatable biomass to cover maintenance respiration, the  
+                  ! - maximum allowed allocatable biomass (bm_tax_max) is removed from allocatable biomass.
+               ELSE
+	     
+                  bm_alloc_tot(i,j) = bm_alloc_tot(i,j) - bm_tax_max(i)
+
+                  ! ::bm_pump is the amount of maintenance respiration that exceeds the maximum allocatable biomass
+                  ! This amount of biomass still needs to be respired and will be removed from tissues biomass of each
+                  ! plant compartment
+                  bm_pump(i) = resp_maint(i,j) * dt - bm_tax_max(i)
+
+                  ! The biomass is removed from each plant compartment tissues as the ratio of the maintenance		
+                  ! respiration of the plant compartment to the total maintenance respiration (resp_maint_part/resp_maint)
+                  biomass(i,j,ileaf,icarbon) = biomass(i,j,ileaf,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,ileaf) / resp_maint(i,j)
+                  biomass(i,j,isapabove,icarbon) = biomass(i,j,isapabove,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,isapabove) / resp_maint(i,j)
+                  biomass(i,j,isapbelow,icarbon) = biomass(i,j,isapbelow,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,isapbelow) / resp_maint(i,j)
+                  biomass(i,j,iroot,icarbon) = biomass(i,j,iroot,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,iroot) / resp_maint(i,j)
+                  biomass(i,j,ifruit,icarbon) = biomass(i,j,ifruit,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,ifruit) / resp_maint(i,j)
+                  biomass(i,j,icarbres,icarbon) = biomass(i,j,icarbres,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,icarbres) / resp_maint(i,j)
+               ENDIF
+          ELSE
+             biomass(i,j,icarbres,icarbon) = biomass(i,j,icarbres,icarbon) + & 
+                  bm_alloc_tot(i,j) - resp_maint(i,j) * dt 
+             bm_alloc_tot(i,j) = 0. 
+          ENDIF	! End if there is enough allocatable biomass to cover maintenance respiration
+
+       ENDDO   ! Fortran95: WHERE - ELSEWHERE construct
+
+       
+       !! 3.3 Allocate allocatable biomass to different plant compartments.
+       !      The amount of allocatable biomass of each compartment is a fraction according f_alloc of total 
+       !      allocatable biomass (the f_alloc of the different plant parts are calculated in stomate_alloc.f90)
+
+       !! liulya here is some great difference with xchen, and mod by xchen has comment out
+       DO k = 1, nparts
+          bm_alloc(:,j,k,icarbon) = f_alloc(:,j,k) * bm_alloc_tot(:,j)
+       ENDDO
+
+       
+       !! 3.4 Calculate growth respiration of each plant compartment.
+       !      Growth respiration of a plant compartment is a fraction of the allocatable biomass remaining after
+       !      maintenance respiration losses have been taken into account. The fraction of allocatable biomass 
+       !      removed for growth respiration is the same for all plant compartments and is defined by the parameter
+       !      frac_growth_resp in stomate_constants.f90. Allocatable biomass ::bm_alloc is updated as a result of 
+       !      the removal of growth resp.
+       resp_growth_part(:,:) = frac_growthresp(j) * bm_alloc(:,j,:,icarbon) / dt
+       bm_alloc(:,j,:,icarbon) = ( un - frac_growthresp(j) ) * bm_alloc(:,j,:,icarbon)
+
+       
+       !! 3.5 Total growth respiration 
+       !      Calculate total growth respiration of the plant as the sum of growth respiration of all plant parts	
+       resp_growth(:,j) = zero
+
+       DO k = 1, nparts
+          resp_growth(:,j) = resp_growth(:,j) + resp_growth_part(:,k)
+       ENDDO
+
+    ENDDO ! # End Loop over # of PFTs
+
+    
+ !! 4. Update the biomass with newly allocated biomass after respiration
+ 
+    !  Save the old leaf biomass for later. "old" leaf mass is leaf mass after maintenance respiration in the case 
+    !  where maintenance respiration has required taking biomass from tissues in section 3.3 
+    lm_old(:,:) = biomass(:,:,ileaf,icarbon)
+    biomass(:,:,:,:) = biomass(:,:,:,:) + bm_alloc(:,:,:,:)
+
+    
+ !! 5. Deal with negative biomasses
+    
+    !  Biomass can become negative in some rare cases, as the GPP can be negative. This corresponds to  
+    !  situations that can be seen as the 'creation' of a seed ('virtual photosynthesis'). In this case, we set
+    !  biomass to a small value (min_stomate). For carbon budget to remain balanced, this creation of matter (carbon)
+    !  is added to co2_to_bm. In previous versions, this carbon was taken from the autotrophic respiration. 
+    DO k = 1, nparts	! Loop over # of plant parts
+
+       DO j = 2,nvm	! Loop over # of PFTs
+
+          WHERE ( biomass(:,j,k,icarbon) .LT. zero )
+            
+             bm_create(:,j) = min_stomate - biomass(:,j,k,icarbon)
+
+             ! Set biomass to min_stomate 
+             biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_create(:,j)
+
+             co2_to_bm(:,j) = co2_to_bm(:,j) + bm_create(:,j) 
+
+          ENDWHERE
+
+       ENDDO	! Loop over # of PFTs
+
+    ENDDO	! Loop over # plant parts
+
+    
+ !! 6. Calculate NPP (See Eq 1 in header)
+    
+    !  Calculate the NPP @tex $(gC.m^{-2}dt^{-1})$ @endtex as the difference between GPP
+    !  and autotrophic respiration (maintenance and growth respirations)
+    DO j = 2,nvm	! Loop over # PFTs
+       npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j)
+    ENDDO	! Loop over # PFTs
+
+    
+ !! 7. Update leaf age
+
+    !  Leaf age is needed for calculation of turnover and vmax in stomate_turnover.f90 and stomate_vmax.f90 routines. 
+    !  Leaf biomass is distributed according to its age into several "age classes" with age class=1 representing the
+    !  youngest class, and consisting of the most newly allocated leaf biomass 
+    
+    !! 7.1 Update quantity and age of the leaf biomass in the youngest class
+    !      The new amount of leaf biomass in the youngest age class (leaf_mass_young) is the sum of :
+    !      - the leaf biomass that was already in the youngest age class (leaf_frac(:,j,1) * lm_old(:,j)) with the 
+    !        leaf age given in leaf_age(:,j,1) 
+    !      - and the new biomass allocated to leaves (bm_alloc(:,j,ileaf)) with a leaf age of zero.
+    DO j = 2,nvm
+       leaf_mass_young(:,j) = leaf_frac(:,j,1) * lm_old(:,j) + bm_alloc(:,j,ileaf,icarbon)
+    ENDDO
+
+    ! The age of the updated youngest age class is the average of the ages of its 2 components: bm_alloc(leaf) of age
+    ! '0', and leaf_frac*lm_old(=leaf_mass_young-bm_alloc) of age 'leaf_age(:,j,1)' 
+    DO j = 2,nvm
+       WHERE ( ( bm_alloc(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+         ( leaf_mass_young(:,j) .GT. min_sechiba ) )
+
+          leaf_age(:,j,1) = MAX ( zero, &
+               & leaf_age(:,j,1) * &
+               & ( leaf_mass_young(:,j) - bm_alloc(:,j,ileaf,icarbon) ) / &
+               & leaf_mass_young(:,j) )
+          
+       ENDWHERE
+    ENDDO
+
+    !! 7.2 Update leaf age
+    !      Update fractions of leaf biomass in each age class (fraction in youngest class increases)
+
+    !! 7.2.1 Update age of youngest leaves
+    !        For age class 1 (youngest class), because we have added biomass to the youngest class, we need to update
+    !        the fraction of total leaf biomass that belongs to the youngest age class : updated mass in class divided
+    !        by new total leaf mass
+    DO j = 2,nvm
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+          leaf_frac(:,j,1) = leaf_mass_young(:,j) / biomass(:,j,ileaf,icarbon)
+
+       ENDWHERE
+    ENDDO
+
+    !! 7.2.2 Update age of other age classes
+    !        Because the total leaf biomass has changed, we need to update the fraction of leaves in each age class:
+    !        mass in leaf age class (from previous fraction of leaves in this class and previous total leaf biomass) 
+    !        divided by new total mass
+    DO m = 2, nleafages	! Loop over # leaf age classes
+
+       DO j = 2,nvm	! Loop over # PFTs
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+       ENDDO
+
+    ENDDO	! Loop over # leaf age classes
+
+    !!liulyc calculate sla_age 1 2 3 4
+
+ !! 8. Update whole-plant age 
+    
+    !! 8.1 PFT age
+    !      At every time step, increase age of the biomass that was already present at previous time step. 
+    !      Age is expressed in years, and the time step 'dt' in days so age increase is: dt divided by number 
+    !      of days in a year.
+    WHERE ( PFTpresent(:,:) )
+
+       age(:,:) = age(:,:) + dt/one_year
+
+    ELSEWHERE
+
+       age(:,:) = zero
+
+    ENDWHERE
+
+    !! 8.2 Age of grasses and crops
+    !  For grasses and crops, biomass with age 0 has been added to the whole plant with age 'age'. New biomass is the sum of 
+    !  the current total biomass in all plant parts (bm_new), bm_new(:) = SUM( biomass(:,j,:), DIM=2 ). The biomass that has 
+    !  just been added is the sum of the allocatable biomass of all plant parts (bm_add), its age is zero. bm_add(:) = 
+    !  SUM( bm_alloc(:,j,:), DIM=2 ). Before allocation, the plant biomass is bm_new-bm_add, its age is "age(:,j)". The age of
+    !  the new biomass is the average of the ages of previous and added biomass.
+    !  For trees, age is treated in "establish" if vegetation is dynamic, and in turnover routines if it is static (in this 
+    !  case, only the age of the heartwood is accounted for).
+    DO j = 2,nvm
+
+       IF ( .NOT. is_tree(j) ) THEN
+
+          bm_new(:) = biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
+               biomass(:,j,iroot,icarbon) + biomass(:,j,ifruit,icarbon)
+          bm_add(:) = bm_alloc(:,j,ileaf,icarbon) + bm_alloc(:,j,isapabove,icarbon) + &
+               bm_alloc(:,j,iroot,icarbon) + bm_alloc(:,j,ifruit,icarbon)
+
+          WHERE ( ( bm_new(:) .GT. min_sechiba ) .AND. ( bm_add(:) .GT. zero ) )
+             age(:,j) = age(:,j) * ( bm_new(:) - bm_add(:) ) / bm_new(:)
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+ !! 9. Write history files
+
+    CALL xios_orchidee_send_field("BM_ALLOC_LEAF",bm_alloc(:,:,ileaf,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_SAP_AB",bm_alloc(:,:,isapabove,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_SAP_BE",bm_alloc(:,:,isapbelow,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_ROOT",bm_alloc(:,:,iroot,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_FRUIT",bm_alloc(:,:,ifruit,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_RES",bm_alloc(:,:,icarbres,icarbon))
+
+    !!@xchen lai for leaf age class1-4 for caculating PC in Wu's science paper
+   !  lai_cl1(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,1)*sla_age1(:,:)
+   !  lai_cl2(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,2)*sla_age2(:,:)    
+   !  lai_cl3(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,3)*sla_age3(:,:)    
+   !  lai_cl4(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,4)*sla_age4(:,:) 
+    !! liulyw why here but no sent to XIOS or write to file? so here are useless? include sla_age1234
+    
+   !  CALL xios_orchidee_send_field("LEAF_BM_CL1",biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,1))
+   !  CALL xios_orchidee_send_field("LEAF_BM_CL2",biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,2))
+   !  CALL xios_orchidee_send_field("LEAF_BM_CL3",biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,3))
+   !  CALL xios_orchidee_send_field("LEAF_BM_CL4",biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,4))
+
+
+
+    ! Save in history file the variables describing the biomass allocated to the plant parts
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_LEAF', itime, &
+         bm_alloc(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_SAP_AB', itime, &
+         bm_alloc(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_SAP_BE', itime, &
+         bm_alloc(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_ROOT', itime, &
+         bm_alloc(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_FRUIT', itime, &
+         bm_alloc(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_RES', itime, &
+         bm_alloc(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving npp'
+
+  END SUBROUTINE npp_calc
+
+END MODULE stomate_npp
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_phenology.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_phenology.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_phenology.f90	(revision 8430)
@@ -0,0 +1,1711 @@
+! =================================================================================================================================
+! MODULE        : stomate_phenology
+!
+! CONTACT       : orchidee-help _at_ listes.ipsl.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 time, ONLY : LastTsYear
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC phenology,phenology_clear
+
+  ! first call
+  LOGICAL, SAVE                                              :: firstcall_all_phenology = .TRUE.
+!$OMP THREADPRIVATE(firstcall_all_phenology)
+  LOGICAL, SAVE                                              :: firstcall_hum = .TRUE.
+!$OMP THREADPRIVATE(firstcall_hum)
+  LOGICAL, SAVE                                              :: firstcall_moi = .TRUE.
+!$OMP THREADPRIVATE(firstcall_moi)
+  LOGICAL, SAVE                                              :: firstcall_humgdd = .TRUE.
+!$OMP THREADPRIVATE(firstcall_humgdd)
+  LOGICAL, SAVE                                              :: firstcall_moigdd = .TRUE.
+!$OMP THREADPRIVATE(firstcall_moigdd)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : phenology_clear
+!!
+!>\BRIEF          Flags setting   
+!!
+!! DESCRIPTION  : This subroutine sets flags 
+!!                ::firstcall_all_phenology, ::firstcall_hum, ::firstcall_moi, ::firstcall_humgdd, 
+!!                ::firstcall_moigdd to .TRUE., and therefore activates section 1.1 of each 
+!!                subroutine which writes messages to the output. \n
+!!                This subroutine is called at the beginning of ::stomateLpj_clear in the 
+!!                ::stomate_lpj module.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall_all_phenology, ::firstcall_hum, ::firstcall_moi, ::firstcall_humgdd, 
+!!                ::firstcall_moigdd
+!!
+!! REFERENCE(S)  : None
+!!
+!! FLOWCHART     : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE phenology_clear
+    firstcall_all_phenology=.TRUE.
+    firstcall_hum=.TRUE.
+    firstcall_moi = .TRUE.
+    firstcall_humgdd = .TRUE.
+    firstcall_moigdd = .TRUE.
+  END SUBROUTINE phenology_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : phenology
+!!
+!>\BRIEF          This subroutine controls the detection of the beginning of the growing season 
+!!                (if dormancy has been long enough), leaf onset, given favourable biometeorological 
+!!                conditions, and leaf growth and biomass allocation when leaf biomass is low (i.e. 
+!!                at the start of the growing season.
+!!
+!! DESCRIPTION  : This subroutine is called by the module ::stomate_lpj and deals with the beginning of the  
+!!                growing season. First it is established whether the beginning of the growing season is
+!!                allowed. This occurs if the dormance period has been long enough (i.e. greater 
+!!                than a minimum PFT-dependent threshold, specified by ::lowgpp_time), 
+!!                AND if the last beginning of the growing season was a sufficiently long time ago 
+!!                (i.e. when the growing season length is greater than a minimum threshold, specified
+!!                by ::min_growthinit_time, which is defined in this module to be 300 days. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                ::lowgpp_time is set for each PFT in ::stomate_data from a table of all
+!!                PFT values (::lowgpp_time_tab), which is defined in ::stomate_constants. \n
+!!                The growing season length is given by ::when_growthinit, which increases
+!!                by the stomate time-step at each call to this phenology module, except for when
+!!                leaf onset is detected, when it is set to 0. \n
+!!                If these two conditions are met, leaf onset occurs if the biometeorological 
+!!                conditions are also met. This is determined by the leaf onset models, which are
+!!                biome-specific. Each PFT is looped over (ignoring bare soil).
+!!                The onset phenology model is selected, (according to the parameter 
+!!                ::pheno_model, which is initialised in stomate_data), and called. \n
+!!                There are six leaf onset phenology models currently being used by ORCHIDEE. 
+!!                These are: 'hum' and 'moi', which are based exclusively on moisture conditions,
+!!                'humgdd' and 'moigdd', which are based on both temperature and moisture conditions,
+!!                'ncdgdd', which is based on a "chilling" requirement for leaf onset, and 
+!!                'ngd', which is based on the number of growing days since the temperature was 
+!!                above a certain threshold, to account for the end of soil frost.
+!!                Those models which are based mostly on temperature conditions are used for
+!!                temperate and boreal biomes, and those which include a moisture condition are used
+!!                for tropical biomes. More detail on the biometeorological conditions is provided
+!!                in the sections on the individual onset models. \n
+!!                The moisture conditions are based on the concept of plant "moisture availability".
+!!                This is based on the soil humidity (relative soil moisture), but is moderated by
+!!                the root density profile, as per the equation:
+!!                \latexonly
+!!                \input{phenology_moiavail_eqn1.tex}
+!!                \endlatexonly
+!!                \n
+!!                Although some studies have shown that the length of the photoperiod is important
+!!                in determining onset (and senescence) dates, this is not considered in the current
+!!                versions of the onset models (Krinner et al., 2005). \n
+!!                If conditions are favourable, leaf onset occurs (::begin_leaves is set to TRUE), 
+!!                ::when_growthinit is set to 0.0, and the growing season has begun. \n
+!!                Following the detection of leaf onset, biomass is allocated from the carbohydrate 
+!!                reserves equally to the leaves and roots IF the leaf biomass is lower than a minimum
+!!                threshold, which is calculated in this subroutine from the parameter
+!!                ::lai_initmin, divided by the specific leaf area (both of which are
+!!                PFT-dependent and set in ::stomate_constants). \n
+!!                Finally, if biomass is required to be allocated from the carbohydrate reserve 
+!!                because the leaf biomass is too low, the leaf age and leaf age distribution is 
+!!                re-set. In this case the youngest age class fraction is set to 1 and all other   
+!!                leaf age class fractions are set to 0. All leaf ages are set to 0. If there is 
+!!                no biomass in the carbohydrate reserve, leaf onset will not occur and the PFT
+!!                will disappear from the grid cell (Krinner et al., 2005). \n
+!!                This subrouting is called in ::stomate_lpj.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::biomass, 
+!!                        ::when_growthinit,
+!!                        ::leaf age distribution
+!!                        ::leaf fraction
+!!
+!! REFERENCE(S) :
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{phenology_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE phenology (npts, dt, PFTpresent, &
+       veget_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, &
+       senescence, time_hum_min, &
+       biomass, leaf_frac, leaf_age, &
+       when_growthinit, co2_to_bm, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                          :: npts                 !! Domain size - number of grid 
+                                                                                                !! cells (unitless) 
+    REAL(r_std), INTENT(in)                                             :: dt                   !! time step (dt_days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                            :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: veget_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(inout)                     :: gdd_midwinter        !! growing degree days, since 
+                                                                                                !! midwinter (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: ncd_dormance         !! number of chilling days since 
+                                                                                                !! leaves were lost (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: ngd_minus5           !! number of growing days above a 
+                                                                                                !! threshold of -5 deg C (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                            :: senescence           !! is the plant senescent? (only 
+                                                                                                !! for deciduous trees - 
+                                                                                                !! carbohydrate reserve) 
+                                                                                                !! (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: time_hum_min         !! time elapsed since strongest 
+                                                                                                !! moisture availability (days) 
+
+    !
+    !! 0.2 Ouput variables 
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)    :: biomass              !! biomass @tex ($gC m^{-2} of 
+                                                                                                !! ground$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)           :: leaf_frac            !! fraction of leaves in leaf age 
+                                                                                                !! class (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)           :: leaf_age             !! leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: when_growthinit      !! how many days since the 
+                                                                                                !! beginning of the growing season 
+                                                                                                !! (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: co2_to_bm            !! co2 taken up by carbohydrate 
+                                                                                                !! reserve at the beginning of the 
+                                                                                                !! growing season @tex ($gC m^{-2} 
+                                                                                                !! of total ground/day$) @endtex 
+                                                                                                ! NV passge 2D
+    LOGICAL, DIMENSION(npts,nvm), INTENT(out)                           :: begin_leaves         !! signal to start putting leaves on (true/false) 
+
+    !
+    !! 0.4 Local variables
+    !
+    LOGICAL, DIMENSION(npts,nvm)                                        :: allow_initpheno      !! are we allowed to decalre the 
+                                                                                                !! beginning of the growing 
+                                                                                                !! season? (true/false) 
+    REAL(r_std), DIMENSION(npts)                                        :: bm_wanted            !! biomass we would like to have 
+                                                                                                !! @tex ($gC m^{-2} of ground$) 
+                                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts)                                        :: bm_use               !! biomass we use (from 
+                                                                                                !! carbohydrate reserve or from 
+                                                                                                !! atmosphere) @tex ($gC m^{-2} of 
+                                                                                                !! ground$) @endtex
+    REAL(r_std), DIMENSION(npts)                                        :: lm_min               !! minimum leaf mass @tex ($gC 
+                                                                                                !! m^{-2} of ground$) @endtex 
+    LOGICAL(r_std), DIMENSION(npts)                                     :: age_reset            !! does the leaf age distribution 
+                                                                                                !! have to be reset? (true/false) 
+    INTEGER(i_std)                                                      :: i,j,m                !! indices (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                                    :: histvar              !! controls the history output 
+                                                                                                !! level - 0: nothing is written; 
+                                                                                                !! 10: everything is written 
+                                                                                                !! (0-10, unitless) 
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering phenology'
+
+    !
+    !! 1. first call - output message giving the setting of the ::always_init
+    !!    and ::min_growthinit_time parameters.
+    !
+
+    IF ( firstcall_all_phenology ) THEN
+
+       IF (printlev >= 2) 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
+       END IF
+       firstcall_all_phenology = .FALSE.
+
+    ENDIF
+
+    !
+    !! 2. Detection of the beginning of the growing season.
+    !
+
+    !
+    !! 2.1 allow detection of the beginning of the growing season if dormance was
+    !!     long enough (i.e. when ::time_lowgpp, which is calculated in ::stomate_season, 
+    !!     is above a certain PFT-dependent threshold, ::lowgpp_time, 
+    !!     which is given in ::stomate_constants),
+    !!     AND the last beginning of growing season was a sufficiently long time ago 
+    !!     (i.e. when ::when_growthinit, which is calculated in this module, 
+    !!     is greater than ::min_growthinit_time, which is declared at the beginning of this module).
+    !!     If these conditions are met, allow_initpheno is set to TRUE. Each PFT is looped over.
+    !
+
+    allow_initpheno(:,1) = .FALSE.
+    DO j = 2,nvm
+
+       WHERE ( when_growthinit(:,j) .GT. min_growthinit_time )
+          allow_initpheno(:,j) = .TRUE.
+       ELSEWHERE
+          allow_initpheno(:,j) = .FALSE.
+       ENDWHERE
+
+    ENDDO
+
+    WHERE(allow_initpheno)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("ALLOW_INITPHENO",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'ALLOW_INITPHENO', itime, histvar, npts*nvm, horipft_index)
+
+    !
+    !! 2.2 increase the ::when_growthinit counter, which gives the number of days since the beginning of the growing season.
+    !!     Needed for allocation and for the detection of the beginning of the growing season.
+    !
+
+    when_growthinit(:,:) = when_growthinit(:,:) + dt
+
+    !
+    !! 3. Leaf onset.
+    !!    Check biometeorological conditions using the onset phenological models, 
+    !!    which are different for each PFT group (i.e. grass versus tropical etc. 
+    !!    See below for more detail on the different models and which PFTs use each model).
+    !
+
+    !! - By default: phenology does not start (::begin_leaves set to FALSE).
+    begin_leaves(:,:) = .FALSE.
+
+    !! - The onset phenology model is selected, (according to the parameter ::pheno_model, 
+    !! which is initialised in stomate_data), and called.
+    !! Each PFT is looped over (ignoring bare soil). 
+    !! If conditions are favourable, begin_leaves is set to TRUE.
+    
+    ! parameter used in all the differents models of phenology 
+    t_always = ZeroCelsius + t_always_add
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       SELECT CASE ( pheno_model(j) )
+
+       CASE ( 'hum' )
+
+          CALL pheno_hum (npts, j, PFTpresent, allow_initpheno, &
+               moiavail_month, moiavail_week, &
+               maxmoiavail_lastyear, minmoiavail_lastyear, &
+               begin_leaves)
+
+       CASE ( 'moi' )
+
+          CALL pheno_moi (npts, j, PFTpresent, allow_initpheno, &
+               time_hum_min, &
+               moiavail_month, moiavail_week, &
+               begin_leaves)
+
+
+       CASE ( 'ncdgdd' )
+
+          CALL pheno_ncdgdd (npts, j, PFTpresent, allow_initpheno, &
+               ncd_dormance, gdd_midwinter, &
+               t2m_month, t2m_week, begin_leaves)
+
+       CASE ( 'ngd' )
+
+          CALL pheno_ngd (npts, j, PFTpresent, allow_initpheno, ngd_minus5, &
+               t2m_month, t2m_week, begin_leaves)
+
+       CASE ( 'humgdd' )
+
+          CALL pheno_humgdd (npts, j, PFTpresent, allow_initpheno, gdd_m5_dormance, &
+               maxmoiavail_lastyear, minmoiavail_lastyear, &
+               t2m_longterm, t2m_month, t2m_week, &
+               moiavail_week, moiavail_month, &
+               begin_leaves)
+
+       CASE ( 'moigdd' )
+
+          CALL pheno_moigdd (npts, j, PFTpresent, allow_initpheno, gdd_m5_dormance, &
+               time_hum_min, &
+               t2m_longterm, t2m_month, t2m_week, &
+               moiavail_week, moiavail_month, &
+               begin_leaves)
+
+       CASE ( 'none' )
+
+          ! no action
+
+       CASE default
+
+          WRITE(numout,*) 'phenology: don''t know how to treat this PFT.'
+          WRITE(numout,*) '  number: (::j)',j
+          WRITE(numout,*) '  phenology model (::pheno_model(j)) : ',pheno_model(j)
+          CALL ipslerr_p(3,'stomate phenology','Cannot treat this PFT','','')
+
+       END SELECT
+
+    ENDDO
+
+    WHERE(begin_leaves)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("BEGIN_LEAVES",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'BEGIN_LEAVES', itime, histvar, npts*nvm, horipft_index)
+
+    !
+    !! 4. Leaf growth and biomass allocation when leaf biomass is low.
+    !!   Leaves start to grow if biometeorological conditions are favourable (::begin_leaves == TRUE) and if
+    !!   leaf growth is allowed (::allow_initpheno == TRUE).
+    !!   PFTs and then grid cells are looped over.
+    !
+
+    !! Added the case((pheno_model(j) == "none") .AND. (biomass(i,j,ileaf,icarbon).LT. min_sechiba)) condition
+    !! to deal with extreme cases when the evergreen leaf biomass reaches zero 
+    IF ( LastTsYear ) THEN 
+      DO j = 2, nvm
+        DO i = 1, npts
+          IF (((veget_cov_max(i,j) .GT. min_sechiba) .AND. always_init(j)) .AND. ((pheno_model(j) == "none") &
+                  .AND. (biomass(i,j,ileaf,icarbon) .LT. min_sechiba)))   THEN
+             lm_min(i) = lai_initmin(j) / sla(j)
+             biomass(i,j,ileaf,icarbon) = biomass(i,j,ileaf,icarbon) + lm_min(i)
+             biomass(i,j,iroot,icarbon) = biomass(i,j,iroot,icarbon) + lm_min(i)
+             co2_to_bm(i,j) = co2_to_bm(i,j) + ( lm_min(i) * 2 ) / dt
+
+             !! 4.0.1 fractions - set the youngest age class fraction to 1 and all other leaf age class fractions to 0.
+             leaf_frac(i,j,1) = un
+             DO m = 2, nleafages
+                leaf_frac(i,j,m) = zero
+             ENDDO ! m = 2, nleafages
+             
+             !! 4.0.2 ages - set all leaf ages to 0.
+             DO m = 1, nleafages
+                leaf_age(i,j,m) = zero
+             ENDDO ! m = 1, nleafages
+
+          ENDIF
+        END DO
+      END DO
+    END IF
+
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       age_reset(:) = .FALSE.
+
+       DO i = 1, npts
+
+          IF ( begin_leaves(i,j) ) THEN
+
+             !! 4.1 First minimum biomass is calculated using the following equation:
+             !!     \latexonly
+             !!     \input{phenology_lm_min_eqn2.tex}
+             !!     \endlatexonly
+             !!     \n
+
+             lm_min(i) = lai_initmin(j) / sla(j)
+
+             !! 4.2 If leaf biomass is lower than the minimum biomass then biomass must be allocated from the carbohydrate 
+             !!     reserves to leaves and roots.
+
+             IF ( biomass(i,j,ileaf,icarbon) .LT. lm_min(i) ) THEN
+
+                !
+                !! 4.2.1 Determine how much biomass is available to use
+                !!       First calculate how much biomass is wanted/required 
+                !!       (::bm_wanted = 2 x the minimum leaf biomass).
+                !
+
+                bm_wanted(i) = 2. * lm_min(i)
+
+                !! 4.2.2 If the biomass in the carbohydrate reserves is less than the required biomass
+                !!       take the required amount of carbon from the atmosphere and put it into the
+                !!       carbohydrate reserve. This only occurs if the parameter ::always_init 
+                !!       (set at beginning of this ::subroutine) is TRUE. Default is FALSE. 
+
+                IF ( always_init(j) .AND. ( biomass(i,j,icarbres,icarbon) .LT. bm_wanted(i) ) ) THEN
+                   !NV passage 2D
+                   co2_to_bm(i,j) = co2_to_bm(i,j) + ( bm_wanted(i) - biomass(i,j,icarbres,icarbon) ) / dt
+
+                   biomass(i,j,icarbres,icarbon) = bm_wanted(i)
+
+                ENDIF
+                
+                !! 4.2.3 The biomass available to use is set to be the minimum of the biomass of the carbohydrate reservoir (if 
+                !! carbon not taken from the atmosphere), and the wanted biomass.
+                bm_use(i) = MIN( biomass(i,j,icarbres,icarbon), bm_wanted(i) )
+
+                !
+                !! 4.2.4 divide the biomass which is available to use equally between the leaves and roots.
+                !
+
+                biomass(i,j,ileaf,icarbon) = biomass(i,j,ileaf,icarbon) + bm_use(i) / 2.
+
+                biomass(i,j,iroot,icarbon) = biomass(i,j,iroot,icarbon) + bm_use(i) / 2.
+
+                !
+                !! 4.2.5 decrease carbohydrate reservoir biomass by the amount that's been allocated to the leaves and roots
+                !
+
+                biomass(i,j,icarbres,icarbon) = biomass(i,j,icarbres,icarbon) - bm_use(i)
+
+                !
+                !! 4.2.6 set reset leaf age distribution (::age_reset) flag. Default is TRUE.
+                !     (done later for better vectorization)
+                !
+
+                age_reset(i) = .TRUE.
+
+             ENDIF  ! leaf mass is very low
+
+             !
+             !! 4.3 reset when_growthinit counter: start of the growing season
+             !
+
+             when_growthinit(i,j) = zero
+
+          ENDIF    ! start of the growing season
+
+       ENDDO      ! loop over grid points
+
+       !
+       !! 4.4 reset leaf age distribution where necessary (i.e. when age_reset is TRUE)
+       !!     simply say that everything is in the youngest age class
+       !
+
+       !! 4.4.1 fractions - set the youngest age class fraction to 1 and all other leaf age class fractions to 0.
+
+       WHERE ( age_reset(:) )
+          leaf_frac(:,j,1) = un
+       ENDWHERE
+       DO m = 2, nleafages
+          WHERE ( age_reset(:) )
+             leaf_frac(:,j,m) = zero
+          ENDWHERE
+       ENDDO
+
+       !! 4.4.2 ages - set all leaf ages to 0.
+
+       DO m = 1, nleafages
+          WHERE ( age_reset(:) )
+             leaf_age(:,j,m) = zero
+          ENDWHERE
+       ENDDO
+
+    ENDDO        ! loop over # PFTs
+
+
+    IF (printlev>=3) WRITE(numout,*) 'Leaving phenology'
+
+  END SUBROUTINE phenology
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_hum 
+!!
+!>\BRIEF          The 'hum' onset model initiate leaf onset based exclusively on moisture 
+!!                availability criteria. 
+!!                Currently no PFTs are assigned to this onset model.
+!!
+!! DESCRIPTION  : This model is for tropical biomes, where temperatures are high but moisture
+!!                might be a limiting factor on growth. It is based on leaf onset model 4a in 
+!!                Botta et al. (2000), which adopts the approach of Le Roux (1995). \n
+!!                Leaf onset occurs if the monthly moisture availability is still quite
+!!                low (i.e. lower than the weekly availability), but the weekly availability is 
+!!                higher than the critical threshold ::availability_crit (as it reacts faster), 
+!!                which indicates the weekly moisture availability is increasing.
+!!                OR if the monthly moisture availability is high enough (i.e. above the 
+!!                threshold value ::moiavail_always), leaf onset is initiated if this has not 
+!!                already happened. This allows vegetation in arid areas to respond to rapidly
+!!                changing soil moisture conditions (Krinner et al., 2005). \n
+!!                The critical weekly moisture availability threshold (::availability_crit), is
+!!                calculated in this subroutine, and is a function of last year's maximum and
+!!                minimum moisture availability and the PFT-dependent parameter
+!!                ::hum_frac, which specifies how much of last year's available 
+!!                moisture is required for leaf onset, as per the equation:
+!!                \latexonly
+!!                \input{phenology_moi_availcrit_eqn3.tex}
+!!                \endlatexonly
+!!                \n
+!!                ::hum_frac is set for each PFT in ::stomate_data from a table
+!!                which contains all the PFT values (::hum_frac_tab) in ::stomate_constants. \n
+!!                Last year's maximum and minimum moisture availability and the monthly and 
+!!                weekly moisture availability are  
+!!                The ::pheno_hum subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start.
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Le Roux, X. (1995), Etude et modelisation des echanges d'eau et d'energie
+!! sol-vegetation-atmosphere dans une savane humide, PhD Thesis, University
+!! Pierre et Marie Curie, Paris, France.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_hum.png}
+!! \endlatexonly
+!! \n             
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_hum (npts, j, PFTpresent, allow_initpheno, &
+       moiavail_month, moiavail_week, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declarations
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                             :: npts                  !! Domain size - number of 
+                                                                                                    !! grid cells (unitless) 
+    INTEGER(i_std), INTENT(in)                                             :: j                     !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                               :: PFTpresent            !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                               :: allow_initpheno       !! are we allowed to 
+                                                                                                    !! declare the beginning of 
+                                                                                                    !! the growing season? 
+                                                                                                    !! (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: moiavail_month        !! "monthly" moisture 
+                                                                                                    !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: moiavail_week         !! "weekly" moisture 
+                                                                                                    !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: maxmoiavail_lastyear  !! last year's maximum 
+                                                                                                    !! moisture availability 
+                                                                                                    !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: minmoiavail_lastyear  !! last year's minimum 
+                                                                                                    !! moisture availability 
+                                                                                                    !! (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                            :: begin_leaves          !! signal to start putting 
+                                                                                                    !! leaves on (true/false) 
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                                            :: moiavail_always       !! critical monthly 
+                                                                                                    !! moisture availability - set 
+                                                                                                    !! for tree or grass 
+                                                                                                    !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                                           :: availability_crit     !! critical weekly moisture 
+                                                                                                    !! availability (0-1, unitless)
+    INTEGER(i_std)                                                         :: i                     !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering hum'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of onset model and the moisture availability 
+    !!     parameters for tree and grass
+    !
+
+    IF ( firstcall_hum ) THEN
+
+       IF (printlev >= 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
+       END IF
+       firstcall_hum = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical value ::hum_frac is defined. If not, stop.
+    !
+
+    IF ( hum_frac(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'hum: hum_frac is undefined for PFT (::j)',j
+       CALL ipslerr_p(3,'stomate phenology','hum_frac is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical monthly moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !! The PFT has to be there and start of growing season must be allowed
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+
+          !! 2.1 Calculate the critical weekly moisture availability: depends linearly on the last year 
+          !! minimum and maximum moisture availabilities, and on the parameter ::hum_frac.
+
+          availability_crit(i) = minmoiavail_lastyear(i,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(i,j) - minmoiavail_lastyear(i,j) )
+
+          !! 2.2 Determine if growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     Leaf onset occurs if the monthly moisture availability is still quite
+          !!     low (i.e. lower than the weekly availability), but the weekly availability is 
+          !!     already higher than the critical threshold ::availability_crit (as it reacts faster), 
+          !!     which indicates the weekly moisture availability is increasing.
+          !!     OR if the monthly moisture availability is high enough (i.e. above the threshold value 
+          !!     ::moiavail_always), leaf onset is initiated if this has not already happened.
+
+          IF ( ( ( moiavail_week(i,j)  .GE. availability_crit(i) ) .AND. &
+               ( moiavail_month(i,j) .LT. moiavail_week(i,j) )   ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving hum'
+
+  END SUBROUTINE pheno_hum
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_moi
+!!
+!>\BRIEF          The 'moi' onset model (::pheno_moi) initiates leaf onset based exclusively 
+!!                on moisture availability criteria. 
+!!                It is very similar to the 'hum' onset model but instead of the weekly moisture 
+!!                availability being higher than a constant threshold, the condition is that the 
+!!                moisture minimum happened a sufficiently long time ago. 
+!!                Currently PFT 3 (Tropical Broad-leaved Raingreen) is assigned to this model.
+!!
+!! DESCRIPTION  : This model is for tropical biomes, where temperatures are high but moisture
+!!                might be a limiting factor on growth. It is based on leaf onset model 4b in 
+!!                Botta et al. (2000).
+!!                Leaf onset begins if the plant moisture availability minimum was a sufficiently  
+!!                time ago, as specified by the PFT-dependent parameter ::hum_min_time 
+!!                AND if the "monthly" moisture availability is lower than the "weekly"
+!!                availability (indicating that soil moisture is increasing).
+!!                OR if the monthly moisture availability is high enough (i.e. above the threshold 
+!!                value ::moiavail_always), leaf onset is initiated if this has not already 
+!!                happened. \n
+!!                ::hum_min_time is set for each PFT in ::stomate_data, and is 
+!!                defined in the table ::hum_min_time_tab in ::stomate_constants. \n
+!!                ::moiavail_always is defined for both tree and grass in this subroutine 
+!!                (set to 1. and 0.6 respectively). \n
+!!                The ::pheno_moi subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!        
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start.
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moi.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_moi (npts, j, PFTpresent, allow_initpheno, &
+       time_hum_min, &
+       moiavail_month, moiavail_week, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: time_hum_min    !! time elapsed since strongest moisture 
+                                                                                !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month  !! "monthly" moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week   !! "weekly" moisture availability (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering moi'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of onset model and the moisture availability 
+    !!     parameters for tree and grass
+    !
+
+    IF ( firstcall_moi ) THEN
+       IF (printlev >= 2) 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
+       END IF
+       firstcall_moi = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical value ::hum_min_time is definded. If not, stop
+    !
+
+    IF ( hum_min_time(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moi: hum_min_time is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','hum_min_time is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical monthly moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !! The PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+          
+          !! 2.1 Determine if growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     The favorable season starts if the moisture minimum (::time_hum_min) was a sufficiently long 
+          !!     time ago, i.e. greater than the threshold specified by the parameter ::hum_min_time 
+          !!     and if the "monthly" moisture availability is lower than the "weekly"
+          !!     availability (indicating that soil moisture is increasing).
+          !!     OR if the monthly moisture availability is high enough (i.e. above the threshold value 
+          !!     ::moiavail_always), initiate the growing season if this has not happened yet.
+
+          IF  ( ( ( moiavail_week(i,j) .GT. moiavail_month(i,j) ) .AND. &
+               ( time_hum_min(i,j) .GT. hum_min_time(j) )    ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                     ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving moi'
+
+  END SUBROUTINE pheno_moi
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_humgdd
+!!
+!>\BRIEF          The 'humgdd' onset model initiates leaf onset based on mixed conditions of 
+!!                temperature and moisture availability criteria. 
+!!                Currently no PFTs are assigned to this onset model. 
+!!
+!! DESCRIPTION  : In this model the Growing Degree Day (GDD) model (Chuine, 2000) is combined 
+!!                with the 'hum' onset model (::pheno_hum), which has previously been described,
+!!                in order to account for dependence on both temperature and moisture conditions 
+!!                in warmer climates. \n. 
+!!                The GDD model specifies that daily temperatures above a threshold of -5  
+!!                degrees C are summed, minus this threshold, giving the GDD, starting from 
+!!                the beginning of the dormancy period (::time_lowgpp>0), i.e. since the leaves 
+!!                were lost. \n.
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                Leaf onset begins when the a PFT-dependent GDD-threshold is reached.
+!!                In addition there are temperature and moisture conditions.
+!!                The temperature condition specifies that the monthly temperature has to be 
+!!                higher than a constant threshold (::t_always) OR
+!!                the weekly temperature is higher than the monthly temperature.
+!!                There has to be at least some moisture. The moisture condition 
+!!                is exactly the same as the 'hum' onset model (::pheno_hum), which has already
+!!                been described. \n
+!!                The GDD (::gdd_m5_dormance) is calculated in ::stomate_season. GDD is set to 
+!!                undef if beginning of the growing season detected, i.e. when there is GPP 
+!!                (::time_lowgpp>0).
+!!                The parameter ::t_always is defined as 10 degrees C in this subroutine, 
+!!                as are the parameters ::moisture_avail_tree and ::moisture_avail_grass 
+!!                (set to 1 and 0.6 respectively), which are used in the moisture condition 
+!!                (see ::pheno_moi onset model description). \n
+!!                The PFT-dependent GDD threshold (::gdd_crit) is calculated as in the onset 
+!!                model ::pheno_humgdd, using the equation:
+!!                \latexonly
+!!                \input{phenology_hummoigdd_gddcrit_eqn4.tex}
+!!                \endlatexonly
+!!                \n
+!!                The three GDDcrit parameters (::gdd(j,*)) are set for each PFT in 
+!!                ::stomate_data, and three tables defining each of the three critical GDD
+!!                parameters for each PFT is given in ::gdd_crit1_tab, ::gdd_crit2_tab and 
+!!                ::gdd_crit3_tab in ::stomate_constants. \n
+!!                The ::pheno_humgdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGES: None
+!!                
+!! MAIN OUTPUT VARIABLES: ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Chuine, I (2000), A unified model for the budburst of trees, Journal of 
+!! Theoretical Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_humgdd.png}
+!! \endlatexonly
+!! \n             
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_humgdd (npts, j, PFTpresent, allow_initpheno, gdd, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       t2m_longterm, t2m_month, t2m_week, &
+       moiavail_week, moiavail_month, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts                    !! Domain size - number of grid cells 
+                                                                                        !! (unitless) 
+    INTEGER(i_std), INTENT(in)                               :: j                       !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent              !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno         !! are we allowed to declare the beginning 
+                                                                                        !! of the growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: gdd                     !! growing degree days, calculated since 
+                                                                                        !! leaves have fallen (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: maxmoiavail_lastyear    !! last year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: minmoiavail_lastyear    !! last year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_longterm            !! "long term" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month               !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week                !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week           !! "weekly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month          !! "monthly" moisture availability 
+                                                                                        !! (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves            !! signal to start putting leaves on 
+                                                                                        !! (true/false) 
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: moiavail_crit                   !! critical moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: tl                              !! long term temperature (C)
+    REAL(r_std), DIMENSION(npts)                             :: gdd_crit                        !! critical GDD (C)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering humgdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of the onset model, the values of the  
+    !!     moisture availability parameters for tree and grass, and the value of the 
+    !!     critical monthly temperature.
+    !
+
+    IF ( firstcall_humgdd ) THEN
+
+       IF (printlev >= 2) 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
+       END IF
+
+       firstcall_humgdd = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical values ::gdd and ::pheno_crit_hum_frac are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'humgdd: pheno_gdd_crit is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','pheno_gdd_crit is undefined for this PFT','','')
+
+    ENDIF
+
+    IF ( hum_frac(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'humgdd: hum_frac is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','hum_frac is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!   The PFT has to be there, start of growing season must be allowed, 
+    !!   and GDD has to be defined.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd(i,j) .NE. undef )                           ) THEN
+
+          !! 2.1 Calculate the critical weekly moisture availability: depends linearly on the last year 
+          !! minimum and maximum moisture availabilities, and on the parameter ::hum_frac.,
+          !! (as in the ::pheno_hum model), as per the equation:
+
+          moiavail_crit(i) = minmoiavail_lastyear(i,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(i,j) - minmoiavail_lastyear(i,j) )
+
+          !! 2.2 Calculate the critical GDD (::gdd_crit), which is a function of the PFT-dependent 
+          !!     critical GDD and the "long term" 2 meter air temperatures.  
+
+          tl(i) =  t2m_longterm(i) - ZeroCelsius
+          gdd_crit(i) = pheno_gdd_crit(j,1) + tl(i)*pheno_gdd_crit(j,2) + &
+               tl(i)*tl(i)*pheno_gdd_crit(j,3)
+          
+          !! 2.3 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     - Has the critical gdd been reached and is the temperature increasing?
+          !!     - Is there at least some humidity/moisture availability?
+          !!     This occurs if the critical gdd (::gdd_crit) has been reached 
+          !!     AND that is temperature increasing, which is true either if the monthly
+          !!     temperature being higher than the threshold ::t_always, OR if the weekly
+          !!     temperature is higher than the monthly, 
+          !!     AND finally that there is sufficient moisture availability, which is 
+          !!     the same condition as for the ::pheno_hum onset model.
+
+          IF ( ( gdd(i,j) .GE. gdd_crit(i) ) .AND. &
+               ( ( t2m_week(i) .GT. t2m_month(i) ) .OR. &
+               ( t2m_month(i) .GT. t_always )          ) .AND. &
+               ( ( ( moiavail_week(i,j)  .GE. moiavail_crit(i) ) .AND. &
+               ( moiavail_month(i,j) .LT. moiavail_crit(i) )        ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                   ) )  THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! End loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving humgdd'
+
+  END SUBROUTINE pheno_humgdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_moigdd
+!!
+!>\BRIEF          The 'moigdd' onset model initiates leaf onset based on mixed temperature 
+!!                and moisture availability criteria.
+!!                Currently PFTs 10 - 13 (C3 and C4 grass, and C3 and C4 agriculture) 
+!!                are assigned to this model. 
+!!
+!! DESCRIPTION  : This onset model combines the GDD model (Chuine, 2000), as described for 
+!!                the 'humgdd' onset model (::pheno_humgdd), and the 'moi' model, in order 
+!!                to account for dependence on both temperature and moisture conditions in
+!!                warmer climates. \n
+!!                Leaf onset begins when the a PFT-dependent GDD threshold is reached.
+!!                In addition there are temperature and moisture conditions.
+!!                The temperature condition specifies that the monthly temperature has to be 
+!!                higher than a constant threshold (::t_always) OR
+!!                the weekly temperature is higher than the monthly temperature.
+!!                There has to be at least some moisture. The moisture condition 
+!!                is exactly the same as the 'moi' onset model (::pheno_moi), which has
+!!                already been described. \n
+!!                GDD is set to undef if beginning of the growing season detected.
+!!                As in the ::pheno_humgdd model, the parameter ::t_always is defined as 
+!!                10 degrees C in this subroutine, as are the parameters ::moisture_avail_tree
+!!                and ::moisture_avail_grass (set to 1 and 0.6 respectively), which are used
+!!                in the moisture condition (see ::pheno_moi onset model description). \n
+!!                The PFT-dependent GDD threshold (::gdd_crit) is calculated as in the onset 
+!!                model ::pheno_humgdd, using the equation:
+!!                \latexonly
+!!                \input{phenology_hummoigdd_gddcrit_eqn4.tex}
+!!                \endlatexonly
+!!                \n
+!!                where i and j are the grid cell and PFT respectively.
+!!                The three GDDcrit parameters (::gdd(j,*)) are set for each PFT in 
+!!                ::stomate_data, and three tables defining each of the three critical GDD
+!!                parameters for each PFT is given in ::gdd_crit1_tab, ::gdd_crit2_tab and 
+!!                ::gdd_crit3_tab in ::stomate_constants. \n
+!!                The ::pheno_moigdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): Added temperature threshold for C4 grass (pheno_moigdd_t_crit), Dan Zhu april 2015
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Chuine, I (2000), A unified model for the budburst of trees, Journal of 
+!! Theoretical Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - Still et al., Global distribution of C3 and C4 vegetation: Carbon cycle implications, 
+!! 2003, Global Biogeochemmical Cycles, DOI: 10.1029/2001GB001807. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moigdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_moigdd (npts, j, PFTpresent, allow_initpheno, gdd, &
+       time_hum_min, &
+       t2m_longterm, t2m_month, t2m_week, &
+       moiavail_week, moiavail_month, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to decalre the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: gdd             !! growing degree days, calculated since leaves 
+                                                                                !! have fallen (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: time_hum_min    !! time elapsed since strongest moisture 
+                                                                                !! availability (days) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_longterm    !! "long term" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week   !! "weekly" moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month  !! "monthly" moisture availability (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: tl                              !! long term temperature (C)
+    REAL(r_std), DIMENSION(npts)                             :: gdd_crit                        !! critical GDD (C)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering moigdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of the onset model, the values of the  
+    !!     moisture availability parameters for tree and grass, and the value of the 
+    !!     critical monthly temperature.
+    !
+
+    IF ( firstcall_moigdd ) THEN
+
+       IF (printlev >= 2) 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
+       END IF
+       firstcall_moigdd = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical values ::gdd and ::pheno_crit_hum_min_time are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'moigdd: pheno_gdd_crit is undefined for PFT',j
+       CALL ipslerr_p(3,'stomate phenology','pheno_gdd is undefined for this PFT','','')
+
+    ENDIF
+
+    IF ( hum_min_time(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moigdd: hum_min_time is undefined for PFT',j
+       CALL ipslerr_p(3,'stomate phenology','hum_min is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!    The PFT has to be there, the start of growing season must be allowed, 
+    !!    and GDD has to be defined.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd(i,j) .NE. undef )                           ) THEN
+          
+          !! 2.1 Calculate the critical GDD (::gdd_crit), which is a function of the PFT-dependent 
+          !!     critical GDD and the "long term" 2 meter air temperatures 
+          
+          tl(i) = t2m_longterm(i) - ZeroCelsius
+          gdd_crit(i) = pheno_gdd_crit(j,1) + tl(i)*pheno_gdd_crit(j,2) + &
+               tl(i)*tl(i)*pheno_gdd_crit(j,3)
+
+          !! 2.2 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical gdd (::gdd_crit) has been reached 
+          !!     AND that is temperature increasing, which is true either if the monthly
+          !!     temperature being higher than the threshold ::t_always, OR if the weekly
+          !!     temperature is higher than the monthly, 
+          !!     AND finally that there is sufficient moisture availability, which is 
+          !!     the same condition as for the ::pheno_moi onset model.
+          !!     AND when pheno_moigdd_t_crit is set(for C4 grass), if the average temperature threshold is reached
+
+          IF ( ( gdd(i,j) .GE. gdd_crit(i) ) .AND. &
+               ( ( t2m_week(i) .GT. t2m_month(i) ) .OR. &
+                 ( t2m_month(i) .GT. t_always )  ) .AND. &
+               ( ( ( time_hum_min(i,j) .GT. hum_min_time(j) ) .AND. &
+                 ( moiavail_week(i,j) .GT. moiavail_month(i,j) ) ) .OR. &
+                 ( moiavail_month(i,j) .GE. moiavail_always )  ) .AND. &
+               ( ( pheno_moigdd_t_crit(j) == undef ) .OR. &
+                 (t2m_month(i) .GT. (ZeroCelsius + pheno_moigdd_t_crit(j))) ) ) THEN
+
+             begin_leaves(i,j) = .TRUE.
+             
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving moigdd'
+
+  END SUBROUTINE pheno_moigdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_ncdgdd
+!!
+!>\BRIEF          The Number of Chilling Days - Growing Degree Day (NCD-GDD) model initiates 
+!!                leaf onset if a certain relationship between the number of chilling days (NCD) 
+!!                since leaves were lost, and the growing degree days (GDD) since midwinter, is 
+!!                fulfilled. 
+!!                Currently PFT 6 (Temperate Broad-leaved Summergreen) and PFT 8 (Boreal Broad-
+!!                leaved Summergreen) are assigned to this model.
+!! 
+!! DESCRIPTION  : Experiments have shown that some
+!!                species have a "chilling" requirement, i.e. their physiology needs cold 
+!!                temperatures to trigger the mechanism that will allow the following budburst 
+!!                (e.g. Orlandi et al., 2004). 
+!!                An increase in chilling days, defined as a day with a daily mean air
+!!                temperature below a PFT-dependent threshold, reduces a plant's GDD demand 
+!!                (Cannell and Smith, 1986; Murray et al., (1989); Botta et al., 2000).
+!!                The GDD threshold therefore decreases as NCD 
+!!                increases, using the following empirical negative explonential law:
+!!                \latexonly
+!!                \input{phenology_ncdgdd_gddmin_eqn5.tex}
+!!                \endlatexonly
+!!                \n
+!!                The constants used have been calibrated against data CHECK FOR REFERENCE OR PERSON WHO DID UPDATE.
+!!                Leaf onset begins if the GDD is higher than the calculated minimum GDD
+!!                (dependent upon NCD) AND if the weekly temperature is higher than the monthly 
+!!                temperature. This is to ensure the temperature is increasing. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                The NCD (::ncd_dormance) is calculated in ::stomate_season as  
+!!                the number of days with a temperature below a PFT-dependent constant threshold
+!!                (::ncdgdd_temp), starting from the beginning of the dormancy period
+!!                (::time_lowgpp>0), i.e. since the leaves were lost. \n
+!!                The growing degree day sum of the temperatures higher than 
+!!                ::ncdgdd_temp (GDD) since midwinter (::gdd_midwinter) 
+!!                is also calculated in ::stomate_season.
+!!                Midwinter is detected if the monthly temperature is lower than the weekly
+!!                temperature AND  the monthly temperature is lower than the long-term
+!!                temperature. ::gdd_minter is therefore set to 0 at the beginning of midwinter
+!!                and increased with each temperature greater than the PFT-dependent threshold.
+!!                When midsummer is detected (the opposite of the above conditions), 
+!!                ::gdd_midwinter is set to undef.
+!!                CHECK! WHEN TO START OF DORMANCY BEEN MODIFIED FROM BOTTA- ADD IN?
+!!                The ::pheno_ncdgdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) :
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Cannell, M.J.R. and R.I. Smith (1986), Climatic warming, spring budburst and
+!! frost damage on trees, Journal of Applied Ecology, 23, 177-191.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - Murray, M.B., G.R. Cannell and R.I. Smith (1989), Date of budburst of fifteen 
+!! tree species in Britain following climatic warming, Journal of Applied Ecology,
+!! 26, 693-700.
+!! - Orlandi, F., H. Garcia-Mozo, L.V. Ezquerra, B. Romano, E. Dominquez, C. Galan,
+!! and M. Fornaciari (2004), Phenological olive chilling requirements in Umbria
+!! (Italy) and Andalusia (Spain), Plant Biosystems, 138, 111-116. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_ncdgdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_ncdgdd (npts, j, PFTpresent, allow_initpheno, &
+       ncd_dormance, gdd_midwinter, &
+       t2m_month, t2m_week, begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: ncd_dormance    !! number of chilling days since leaves were lost 
+                                                                                !! (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)          :: gdd_midwinter   !! growing degree days since midwinter (C)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                           :: i               !! index (unitless)
+    REAL(r_std)                                              :: gdd_min         !! critical gdd (C)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering ncdgdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.2 check the critical value ::ncdgdd_temp is defined.
+    !!     If not, stop.
+    !
+
+    IF ( ncdgdd_temp(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ncdgdd: ncdgdd_temp is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','ncdgdd_temp this PFT','','')
+
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.    
+    !!    PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts ! loop over grid points
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd_midwinter(i,j) .NE. undef ) .AND. &
+            ( ncd_dormance(i,j) .NE. undef )                  ) THEN
+
+          !! 2.1 Calculate the critical gdd, which is related to ::ncd_dormance
+          !!     using an empirical negative exponential law as described above.           
+
+          gdd_min = ( gddncd_ref / exp(gddncd_curve*ncd_dormance(i,j)) - gddncd_offset )
+
+          !! 2.2 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical GDD been reached AND the temperatures are increasing.
+          !!     If the growing season has started, ::gdd_midwinter is set to "undef". 
+
+          IF ( ( gdd_midwinter(i,j) .GE. gdd_min ) .AND. &
+               ( t2m_week(i) .GT. t2m_month(i) ) ) THEN
+             begin_leaves(i,j) = .TRUE.
+             gdd_midwinter(i,j)=undef
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving ncdgdd'
+
+  END SUBROUTINE pheno_ncdgdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_ngd
+!!
+!>\BRIEF          The Number of Growing Days (NGD) leaf onset model initiates leaf onset if the NGD, 
+!!                defined as the number of days with temperature above a constant threshold, 
+!!                exceeds a critical value.
+!!                Currently PFT 9 (Boreal Leedleleaf Summergreen) is assigned to this model. 
+!!
+!! DESCRIPTION    The NGD model is a variant of the GDD model. The model was proposed by Botta et
+!!                al. (2000) for boreal and arctic biomes, and is designed to estimate 
+!!                leaf onset after the end of soil frost. 
+!!                The NDG (::ngd_minus5) is the number of days with a daily mean air 
+!!                temperature of greater than -5 degrees C, 
+!!                starting from the beginning of the dormancy period (i.e. time since the leaves 
+!!                were lost/GPP below a certain threshold).
+!!                Leaf onset begins if the NGD is higher than the PFT-dependent constant threshold, 
+!!                ::ngd,  AND if the weekly temperature is higher than the monthly 
+!!                temperature. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                ::ngd_minus5 is also calculated in ::stomate_season. It is initialised at the
+!!                beginning of the dormancy period (::time_lowgpp>0), and increased by the 
+!!                stomate time step when the temperature > -5 degrees C. \n
+!!                ::ngd is set for each PFT in ::stomate_data, and a 
+!!                table defining the minimum NGD for each PFT is given in ::ngd_crit_tab
+!!                in ::stomate_constants. \n
+!!                The ::pheno_ngd subroutine is called in the subroutine ::phenology.      
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347. 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_ngd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_ngd (npts, j, PFTpresent, allow_initpheno, ngd, &
+       t2m_month, t2m_week, begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: ngd             !! growing degree days (C)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                           :: i               !! index (unitless)
+
+    !! =========================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering ngd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.2 check the critical value ::ngd_crit is defined.
+    !!     If not, stop.
+    !
+
+    IF ( ngd_crit(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ngd: ngd_crit is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','ngd_crit is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!    PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+
+          !! 2.1 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical NGD has been reached AND are temperatures increasing.
+
+          IF ( ( ngd(i,j) .GE. ngd_crit(j) ) .AND. &
+               ( t2m_week(i) .GT. t2m_month(i) )        ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving ngd'
+
+  END SUBROUTINE pheno_ngd
+
+END MODULE stomate_phenology
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_prescribe.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_prescribe.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_prescribe.f90	(revision 8430)
@@ -0,0 +1,348 @@
+! =================================================================================================================================
+! MODULE       : stomate_prescribe
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Initialize and update density, crown area.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_prescribe
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC prescribe,prescribe_clear
+
+    ! first call
+    LOGICAL, SAVE                                              :: firstcall_prescribe = .TRUE.
+!$OMP THREADPRIVATE(firstcall_prescribe)
+
+CONTAINS
+
+! =================================================================================================================================
+!! SUBROUTINE   : prescribe_clear
+!!
+!>\BRIEF        : Set the firstcall_prescribe flag back to .TRUE. to prepare for the next simulation.
+!_=================================================================================================================================
+
+  SUBROUTINE prescribe_clear
+    firstcall_prescribe=.TRUE.
+  END SUBROUTINE prescribe_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE   : prescribe
+!!
+!>\BRIEF         Works only with static vegetation and agricultural PFT. Initialize biomass,
+!!               density, crown area in the first call and update them in the following.
+!!
+!! DESCRIPTION (functional, design, flags): \n
+!! This module works only with static vegetation and agricultural PFT.
+!! In the first call, initialize density of individuals, biomass, crown area,
+!! and leaf age distribution to some reasonable value. In the following calls,
+!! these variables are updated.
+!!
+!! To fulfill these purposes, pipe model are used:
+!! \latexonly 
+!!     \input{prescribe1.tex}
+!!     \input{prescribe2.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLES(S): ::ind, ::cn_ind, ::leaf_frac
+!!
+!! REFERENCES   :
+!! - Krinner, G., N. Viovy, et al. (2005). "A dynamic global vegetation model 
+!!   for studies of the coupled atmosphere-biosphere system." Global 
+!!   Biogeochemical Cycles 19: GB1015, doi:1010.1029/2003GB002199.
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!   plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!   global vegetation model, Global Change Biology, 9, 161-185.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE prescribe (npts, &
+                        veget_cov_max, dt, PFTpresent, everywhere, when_growthinit, &
+                        biomass, leaf_frac, ind, cn_ind, co2_to_bm)
+
+!! 0. Parameters and variables declaration
+
+   !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_cov_max   !! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground (unitless;0-1)
+    REAL(r_std), INTENT(in)                                   :: dt              !! time step (dt_days)
+    !! 0.2 Output variables 
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! PFT present (0 or 1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! how many days ago was the beginning of the growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass   !! biomass (gC/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! density of individuals (1/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind          !! crown area per individual (m^2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! co2 taken up by carbohydrate 
+                                                                                 !! reserve at the beginning of the
+                                                                                 !! growing season @tex ($gC m^{-2} 
+                                                                                 !! of total ground/day$) @endtex 
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                              :: dia             !! stem diameter (m)
+    REAL(r_std), DIMENSION(npts)                              :: woodmass        !! woodmass (gC/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts)                              :: woodmass_ind    !! woodmass of an individual (gC)
+    INTEGER(i_std)                                            :: i,j             !! index (unitless)
+
+!_ ================================================================================================================================
+
+    DO j = 2,nvm
+
+      ! only when the DGVM is not activated or agricultural PFT.
+
+      IF ( ( .NOT. ok_dgvm .AND. lpj_gap_const_mort ) .OR. ( .NOT. natural(j) ) ) THEN
+
+        !
+        !! 1.Update crown area
+        !
+
+        cn_ind(:,j) = zero
+
+        IF ( is_tree(j) ) THEN
+
+          !
+          !! 1.1 treat for trees
+          !
+
+          dia(:) = zero
+
+          DO i = 1, npts ! loop over grid points
+
+            IF ( veget_cov_max(i,j) .GT. zero ) THEN
+
+              !! 1.1.1 calculate wood mass on an area basis, which include sapwood and heartwood aboveground and belowground.
+
+              woodmass(i) = (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) + &
+                   biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon)) * veget_cov_max(i,j)  
+
+              IF ( woodmass(i) .GT. min_stomate ) THEN
+
+                !! 1.1.2 calculate critical individual density
+!?? the logic for 1.1.3 and 1.1.2 is strange, it should be the case that first to calculate critical woodmass per individual,
+!?? then calculate critical density.
+
+
+                ! how to derive the following equation:
+                ! first, TreeHeight=pipe_tune2 * Diameter^{pipe_tune3}
+                ! we assume the tree is an ideal cylinder, so it volume is: Volume = pi*(Dia/2)^2*Height = pi/4 * Dia * pipe_tune2*Dia^{pipe_tune3} 
+                !                                                                  = pi/4 * pipe_tune2 * Dia^{2+pipe_tune3}
+                ! last, the woodmass_per_individual = pipe_density * Volume = pipe_density*pi/4.*pipe_tune2 * Dia^{2+pipe_tune3}             
+                ind(i,j) = woodmass(i) / &
+                           ( pipe_density*pi/4.*pipe_tune2 * maxdia(j)**(2.+pipe_tune3) )
+
+                !! 1.1.3 individual biomass corresponding to this critical density of individuals
+
+                woodmass_ind(i) = woodmass(i) / ind(i,j)
+
+                !! 1.1.4 calculate stem diameter per individual tree
+
+                dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** &
+                         ( un / ( 2. + pipe_tune3 ) )
+
+                !! 1.1.5 calculate provisional tree crown area for per individual tree
+
+                ! equation: CrownArea=pipe_tune1 * Diameter^{1.6}
+                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+                !! 1.1.6 If total tree crown area for this tree PFT exceeds its veget_cov_max, tree density is recalculated.
+
+                IF ( cn_ind(i,j) * ind(i,j) .GT. 1.002* veget_cov_max(i,j) ) THEN
+
+                  ind(i,j) = veget_cov_max(i,j) / cn_ind(i,j)
+
+                ELSE
+
+                   ind(i,j) = ( veget_cov_max(i,j) / &
+                        &     ( pipe_tune1 * (woodmass(i)/(pipe_density*pi/4.*pipe_tune2)) &
+                        &     **(pipe_tune_exp_coeff/(2.+pipe_tune3)) ) ) &
+                        &     ** (1./(1.-(pipe_tune_exp_coeff/(2.+pipe_tune3))))
+                   
+
+                  woodmass_ind(i) = woodmass(i) / ind(i,j)
+
+                  dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** &
+                           ( un / ( 2. + pipe_tune3 ) )
+
+                  ! final crown area
+                  cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+                ENDIF
+
+              ELSE !woodmas=0  => impose some value
+
+                dia(:) = maxdia(j)
+
+                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+              ENDIF ! IF ( woodmass(i) .GT. min_stomate )
+
+            ENDIF    ! veget_cov_max .GT. 0.
+
+          ENDDO      ! loop over grid points
+
+        ELSE !grass
+
+          !
+          !! 1.2 grasses: crown area always set to 1m**2
+          !
+
+          WHERE ( veget_cov_max(:,j) .GT. zero )
+            cn_ind(:,j) = un
+          ENDWHERE
+
+        ENDIF   !IF ( is_tree(j) )
+
+        !
+        !! 2 density of individuals
+        !
+        
+        WHERE ( veget_cov_max(:,j) .GT. zero )
+
+          ind(:,j) = veget_cov_max(:,j) / cn_ind(:,j)  
+
+        ELSEWHERE
+
+          ind(:,j) = zero
+
+        ENDWHERE
+
+      ENDIF     ! IF ( ( .NOT. ok_dgvm .AND. lpj_gap_const_mort ) .OR. ( .NOT. natural(j) ) )
+
+    ENDDO       ! loop over PFTs
+
+    !
+    !!? it's better to move the code for first call at the beginning of the module.
+    !! 2 If it's the first call for this module, 
+    !
+
+    IF (( firstcall_prescribe ) .AND. (TRIM(stom_restname_in) == 'NONE')) THEN
+
+       IF (printlev >= 2) THEN
+          WRITE(numout,*) 'prescribe:'
+          ! impose some biomass if zero and PFT prescribed
+          WRITE(numout,*) '   > Imposing initial biomass for prescribed trees, '// &
+               'initial reserve mass for prescribed grasses.'
+          WRITE(numout,*) '   > Declaring prescribed PFTs present.'
+       END IF
+
+      DO j = 2,nvm ! loop over PFTs
+        DO i = 1, npts ! loop over grid points
+
+          ! is vegetation static or PFT agricultural?
+          ! Static vegetation or agricultural PFT
+          IF ( ( .NOT. ok_dgvm ) .OR. &
+               ( ( .NOT. natural(j) ) .AND. ( veget_cov_max(i,j) .GT. min_stomate ) ) ) THEN
+
+            !
+            !! 2.1 if tree biomass is extremely small, prescribe the biomass by assuming they have sapling biomass, which is a constant in the model.
+            !!     then set all the leaf age as 1.
+            !
+            ! if tree PFT and biomass too small, prescribe the biomass to a value.
+            IF ( is_tree(j) .AND. &
+                 ( veget_cov_max(i,j) .GT. min_stomate ) .AND. &
+                 ( SUM( biomass(i,j,:,icarbon) ) .LE. min_stomate ) ) THEN
+               !!? here the code is redundant, as "veget_cov_max(i,j) .GT. min_stomate" is already met in the above if condition.
+               IF (veget_cov_max(i,j) .GT. min_stomate) THEN
+                  biomass(i,j,:,:) = (bm_sapl_rescale * bm_sapl(j,:,:) * ind(i,j)) / veget_cov_max(i,j)
+               ELSE
+                  biomass(i,j,:,:) = zero
+               ENDIF
+
+              ! set leaf age classes
+              leaf_frac(i,j,:) = zero
+              leaf_frac(i,j,1) = un
+
+              ! set time since last beginning of growing season
+              when_growthinit(i,j) = large_value
+
+              ! seasonal trees: no leaves at beginning
+
+              IF ( pheno_model(j) .NE. 'none' ) THEN
+
+                biomass(i,j,ileaf,icarbon) = zero
+                leaf_frac(i,j,1) = zero
+
+              ENDIF
+
+              co2_to_bm(i,j) = co2_to_bm(i,j) + ( SUM(biomass(i,j,:,icarbon))  / dt )
+            ENDIF
+
+            !
+            !! 2.2 for grasses, set only the carbon reserve pool to "sapling" carbon reserve pool.
+            !!     and set all leaf age to 1.
+
+            IF ( ( .NOT. is_tree(j) ) .AND. &
+                 ( veget_cov_max(i,j) .GT. min_stomate ) .AND. &
+                 ( SUM( biomass(i,j,:,icarbon) ) .LE. min_stomate ) ) THEN
+
+              biomass(i,j,icarbres,:) = bm_sapl(j,icarbres,:) * ind(i,j) / veget_cov_max(i,j)
+
+              ! set leaf age classes
+              leaf_frac(i,j,:) = zero
+              leaf_frac(i,j,1) = un
+
+              ! set time since last beginning of growing season
+              when_growthinit(i,j) = large_value
+
+              co2_to_bm(i,j) = co2_to_bm(i,j) + ( biomass(i,j,icarbres,icarbon)  / dt )
+            ENDIF
+
+            !
+            !! 2.3 declare all PFTs with positive veget_cov_max as present everywhere in that grid box
+            !
+
+            IF ( veget_cov_max(i,j) .GT. min_stomate ) THEN
+              PFTpresent(i,j) = .TRUE.
+              everywhere(i,j) = un
+            ENDIF
+
+          ENDIF   ! not ok_dgvm  or agricultural
+
+        ENDDO ! loop over grid points
+      ENDDO ! loop over PFTs
+
+
+   ENDIF
+   
+   firstcall_prescribe = .FALSE.
+
+  END SUBROUTINE prescribe
+
+END MODULE stomate_prescribe
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_resp.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_resp.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_resp.f90	(revision 8430)
@@ -0,0 +1,363 @@
+! =================================================================================================================================
+! MODULE           : stomate_resp
+!
+! CONTACT          : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE          : IPSL (2006)
+!                  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF           Calculates maintenance respiration for different plant components
+!!
+!!\n DESCRIPTION   : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	   :
+!!- McCree KJ. An equation for the respiration of white clover plants grown under controlled conditions. 
+!! In: Setlik I, editor. Prediction and measurement of photosynthetic productivity. Wageningen, The Netherlands: Pudoc; 1970. p. 221-229.
+!! - Krinner G, Viovy N, de Noblet-Ducoudre N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! Ruimy A., Dedieu G., Saugier B. (1996), TURC: A diagnostic model
+!! of continental gross primary productivity and net primary productivity,
+!! Global Biogeochemical Cycles, 10, 269-285.\n
+
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE stomate_resp
+
+  ! modules used:
+  USE stomate_data
+  USE pft_parameters
+  USE constantes  
+  USE constantes_soil 
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC maint_respiration,maint_respiration_clear
+
+  LOGICAL, SAVE                                              :: firstcall_resp = .TRUE.                 !! first call
+!$OMP THREADPRIVATE(firstcall_resp)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: maint_respiration_clear
+!!
+!>\BRIEF        : Set the flag ::firstcall_resp to .TRUE. and as such activate section 
+!!                1.1 of the subroutine maint_respiration (see below).
+!_ ================================================================================================================================
+
+  SUBROUTINE maint_respiration_clear
+    firstcall_resp=.TRUE.
+  END SUBROUTINE maint_respiration_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: maint_respiration
+!!
+!>\BRIEF         Calculate PFT maintenance respiration of each living plant part by 
+!! multiplying the biomass of plant part by maintenance respiration coefficient which
+!! depends on long term mean annual temperature. PFT maintenance respiration is carbon flux 
+!! with the units @tex $(gC.m^{-2}dt_sechiba^{-1})$ @endtex, and the convention is from plants to the 
+!! atmosphere.
+!!
+!! DESCRIPTION : The maintenance respiration of each plant part for each PFT is the biomass of the plant 
+!! part multiplied by maintenance respiration coefficient. The biomass allocation to different 
+!! plant parts is done in routine stomate_alloc.f90. The maintenance respiration coefficient is 
+!! calculated in this routine.\n
+!!
+!! The maintenance respiration coefficient is the fraction of biomass that is lost during 
+!! each time step, which increases linearly with temperature (2-meter air temperature for aboveground plant
+!! tissues; root-zone temperature for below-ground tissues). Air temperature is an input forcing variable. 
+!! Root-zone temperature is a convolution of root and soil temperature profiles and also calculated 
+!! in this routine.\n
+!!
+!! The calculation of maintenance respiration coefficient (fraction of biomass respired) depends linearly
+!! on temperature:
+!! - the relevant temperature for different plant parts (air temperature or root-zone temperature)\n
+!! - intercept: prescribed maintenance respiration coefficients at 0 Degree Celsius for 
+!!   different plant parts for each PFT in routine stomate_constants.f90\n
+!! - slope: calculated with a quadratic polynomial with the multi-annual mean air temperature 
+!! (the constants are in routine stomate_constants.f90) as follows\n 
+!!    \latexonly
+!!      \input{resp3.tex} 
+!!    \endlatexonly
+!!   Where, maint_resp_slope1, maint_resp_slope2, maint_resp_slope3 are constant in stomate_constants.f90.
+!!   Then coeff_maint is calculated as follows:\n
+!!    \latexonly
+!!      \input{resp4.tex} 
+!!    \endlatexonly  
+!! If the calculation result is negative, maintenance respiration coefficient will take the value 0.
+!! Therefore the maintenance respiration will also be 0.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): PFT maintenance respiration of different plant parts (::resp_maint_part_radia)
+!!
+!! REFERENCE(S)	:
+!! McCree KJ. An equation for the respiration of white clover plants grown under controlled conditions. In: 
+!! Setlik I, editor. Prediction and measurement of photosynthetic productivity. Wageningen, 
+!! The Netherlands: Pudoc; 1970. p. 221-229.
+!! Krinner G, Viovy N, de Noblet-Ducoudre N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! Ruimy A., Dedieu G., Saugier B. (1996), TURC: A diagnostic model
+!! of continental gross primary productivity and net primary productivity,
+!! Global Biogeochemical Cycles, 10, 269-285.\n
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE maint_respiration ( npts,lai, t2m,t2m_longterm,stempdiag,height,veget_cov_max,&
+       rprof,biomass,resp_maint_part_radia)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: npts      !! Domain size - number of grid cells (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)           :: t2m       !! 2 meter air temperature - forcing variable (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)           :: t2m_longterm !! Long term annual mean 2 meter reference air temperatures 
+                                                                       !! calculated in stomate_season.f90 (K)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT (in)     :: stempdiag !! Soil temperature of each soil layer (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: height    !! height of vegetation (m)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: veget_cov_max !! PFT "maximal" coverage fraction of a PFT (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: rprof     !! PFT root depth as calculated in stomate.f90 from parameter 
+                                                                    !! humcste which is root profile for different PFTs 
+                                                                    !! in slowproc.f90 (m)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass   !! PFT total biomass calculated in stomate_alloc.f90 
+                                                                    !! @tex $(gC.m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)        :: lai                   !! PFT leaf area index @tex $(m^2 m^{-2})$ @endtex
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: resp_maint_part_radia !! PFT maintenance respiration of different plant
+                                                                                  !! parts @tex $(gC.m^{-2}dt_sechiba^{-1} )$ @endtex
+
+    !! 0.3 Modified variables
+ 
+    !! 0.4 Local variables
+
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)    :: z_soil       !! Variable to store depth of the different soil layers (m)
+!$OMP THREADPRIVATE(z_soil)
+    REAL(r_std), DIMENSION(npts,nvm)        :: t_root               !! PFT root temperature (convolution of root and soil 
+                                                                    !! temperature profiles) (K)
+    REAL(r_std), DIMENSION(npts,nvm,nparts) :: coeff_maint          !! PFT maintenance respiration coefficients of different 
+                                                                    !! plant compartments at 0 deg C 
+                                                                    !! @tex $(g.g^{-1}dt_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts)            :: rpc                  !! Scaling factor for integrating vertical soil 
+                                                                    !! profiles (unitless)
+    REAL(r_std), DIMENSION(npts,nparts)     :: t_maint_radia        !! Temperature which is pertinent for maintenance respiration, 
+                                                                    !! which is air/root temperature for above/below-ground 
+                                                                    !! compartments (K) 
+    REAL(r_std), DIMENSION(npts)            :: tl                   !! Long term reference temperature in degrees Celcius 
+                                                                    !! (= t2m_longterm - 273.15) (C)
+    REAL(r_std), DIMENSION(npts)            :: slope                !! slope of the temperature dependence of maintenance 
+                                                                    !! respiration coefficient (1/K)
+    INTEGER(i_std)                          :: i,j,k,l,m            !! Indeces (unitless)
+    INTEGER(i_std)                          :: ier                  !! Error handling 
+
+!_ ================================================================================================================================
+    
+    
+    IF (printlev>=3) WRITE(numout,*) 'Entering respiration'
+    
+ !! 1. Initializations
+    
+    IF ( firstcall_resp ) THEN
+
+       !! 1.1. Soil levels (first call only)
+       !       Set the depth of the different soil layers (number of layers: nslm) 
+       !       previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90
+       ALLOCATE(z_soil(0:nslm), stat=ier)
+       IF ( ier /= 0 ) CALL ipslerr_p(3,'maint_respiration','Pb in allocate of z_soil','','')
+       z_soil(0) = zero
+       z_soil(1:nslm) = diaglev(1:nslm)
+
+       firstcall_resp = .FALSE.
+    ENDIF
+
+    
+    
+    !! 1.2. Calculate root temperature
+    !       Calculate root temperature as the convolution of root and soil temperature profiles
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 1.2.1 Calculate rpc
+       !  - rpc is an integration constant to make the integral over the root profile is equal 'one', 
+       !    calculated as follows:\n
+       !  \latexonly
+       !    \input{resp1.tex} 
+       !  \endlatexonly
+       rpc(:) = un / ( un - EXP( -z_soil(nslm) / rprof(:,j) ) )
+
+       !! 1.2.2 Calculate root temperature
+       !        - Integrate root profile temperature (K) over soil layers (number of layers = nslm)
+       !          with rpc and soil temperature (K) of each soil layer as follows:\n
+       !        \latexonly
+       !          \input{resp2.tex} 
+       !        \endlatexonly
+       !        Where, stempdiag is diagnostic temperature profile of soil (K)\n
+       t_root(:,j) = zero
+
+       DO l = 1, nslm ! Loop over # soil layers
+
+          t_root(:,j) = &
+               t_root(:,j) + stempdiag(:,l) * rpc(:) * &
+               ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
+
+       ENDDO ! Loop over # soil layers
+
+    ENDDO ! Loop over # PFTs
+
+ !! 2. Define maintenance respiration coefficients
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 2.1 Temperature for maintenanace respiration
+       !      Temperature which is used to calculate maintenance respiration for different plant compartments
+       !      (above- and belowground)\n
+       !      - for aboveground parts, we use 2-meter air temperature, t2m\n
+       !      - for belowground parts, we use root temperature calculated in section 1.2 of this subroutine\n
+       
+       ! 2.1.1 Aboveground biomass
+       t_maint_radia(:,ileaf) = t2m(:)
+       t_maint_radia(:,isapabove) = t2m(:)
+       t_maint_radia(:,ifruit) = t2m(:)
+
+       ! 2.1.2 Belowground biomass
+       t_maint_radia(:,isapbelow) = t_root(:,j)
+       t_maint_radia(:,iroot) = t_root(:,j)
+
+       !! 2.1.3 Heartwood biomass
+       !        Heartwood does does not respire (coeff_maint_zero is set to zero)
+
+       t_maint_radia(:,iheartbelow) = t_root(:,j)
+       t_maint_radia(:,iheartabove) = t2m(:)
+
+       !! 2.1.4 Reserve biomass
+       !        Use aboveground temperature for trees and belowground temeperature for grasses
+       IF ( is_tree(j) ) THEN
+          t_maint_radia(:,icarbres) = t2m(:)
+       ELSE
+          t_maint_radia(:,icarbres) = t_root(:,j)
+       ENDIF
+
+       
+       !! 2.2 Calculate maintenance respiration coefficients (coeff_maint)
+       !      Maintenance respiration is a fraction of biomass defined by the coefficient 
+       !      coeff_maint [Mc Cree, 1969]. Coeff_maint is defined through a linear relationship of temperature [Ruimy et al, 1996]
+       !      which slope is the coefficient 'slope' and which intercept is 'coeff_maint_zero'.
+       !     - Coeff_maint_zero is defined in stomate_data to cm_zero_plantpartname
+       !     - Slope is calculated here through a second-degree polynomial [Krinner et al, 2005] 
+       !    equation that makes it dependent on the long term temperature (to represent adaptation
+       !    of the ecosystem to long term temperature).
+       !         \latexonly
+       !           \input{resp3.tex} 
+       !         \endlatexonly
+       !        Where, maint_resp_slope1, maint_resp_slope2, maint_resp_slope3 are constant in stomate_constants.f90.
+       !        Then coeff_maint is calculated as follows:\n
+       !         \latexonly
+       !           \input{resp4.tex} 
+       !         \endlatexonly
+       ! If the calculation result is negative, coeff_maint will take the value 0.\n	
+       tl(:) = t2m_longterm(:) - ZeroCelsius
+       slope(:) = maint_resp_slope(j,1) + tl(:) * maint_resp_slope(j,2) + &
+            tl(:)*tl(:) * maint_resp_slope(j,3)
+
+       DO k = 1, nparts ! Loop over # plant parts
+
+          coeff_maint(:,j,k) = &
+               MAX( (coeff_maint_zero(j,k)*dt_sechiba/one_day) * &
+               ( un + slope(:) * (t_maint_radia(:,k)-ZeroCelsius) ), zero )
+
+       ENDDO ! Loop over # plant parts
+
+    ENDDO ! Loop over # PFTs
+    
+ !! 3. Calculate maintenance respiration
+
+    ! The maintenance respiration @tex $(gC.m^{-2}dt_sechiba^{-1})$ @endtex of each plant compartment for each PFT is 
+    ! the biomass @tex $(gC.m^{-2})$ @endtex of the plant part multiplied by maintenance respiration 
+    ! coefficient @tex $(g.g^{-1}dt_sechiba^{-1})$ @endtex, except that the maintenance respiration of leaves is 
+    ! corrected by leaf area index (LAI) as follows:\n
+    ! \latexonly     
+    !   \input{resp5.tex} 
+    ! \endlatexonly
+
+    ! ibare_sechiba = 1, which means the there is only bare soil but not any PFT, consequently no LAI and
+    !  maintenance respiration
+    lai(:,ibare_sechiba) = zero
+    resp_maint_part_radia(:,ibare_sechiba,:) = zero
+    
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       ! 3.1 Maintenance respiration of the different plant parts
+       lai(:,j) = biomass(:,j,ileaf,icarbon) * sla(j)
+
+       DO k = 1, nparts ! Loop over # plant parts
+
+          IF ( k .EQ. ileaf ) THEN
+
+             ! Leaves: respiration depends on leaf mass AND LAI.
+!!$                WHERE ( (biomass(:,j,ileaf) > min_stomate) .AND. (lai(:,j) > 0.0) .AND. (lai(:,j) < val_exp) )
+!!$                resp_maint_part_radia(:,j,k) = coeff_maint(:,j,k) * biomass(:,j,k) * &
+!!$                        ( .3*lai(:,j) + 1.4*(1.-exp(-.5*lai(:,j))) ) / lai(:,j)
+!!$             ELSEWHERE
+!!$                resp_maint_part_radia(:,j,k) = 0.0
+!!$             ENDWHERE
+             DO i = 1, npts ! Loop over # pixels
+                IF ( (biomass(i,j,ileaf,icarbon) > min_stomate) .AND. (lai(i,j) > min_stomate) ) THEN
+
+!$                         IF (lai(i,j) < 100._r_std) THEN
+!$                            resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+!$                                 ( .3*lai(i,j) + 1.4*(1.-exp(-.5*lai(i,j))) ) / lai(i,j)
+!$                         ELSE
+!$                            resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+!$                                 ( .3*lai(i,j) + 1.4 ) / lai(i,j)
+!$                         ENDIF
+
+                   ! Maintenance respiration is calculated as a fraction of biomass as defined by coeff_maint and 
+                   ! is adjusted for the nitrogen effect through a third factor depending on LAI. The hypothesis 
+                   ! here is that the vcmax (i.e. the nitrogen distribution) in the canopy decreases exponentially 
+                   ! with LAI following the Beer-Lambert law with an asymptote defining the minimum of the function
+                   ! at 30% of the LAI. The 1.4 parameter is an integration constant.
+                   ! This method is also used in diffuco_trans_co2 2.4.1 for scaling vmax based on nitrogen reduction 
+                   ! in the canopy.
+
+                   resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+                        ( maint_resp_min_vmax*lai(i,j) + maint_resp_coeff*(un - exp(-ext_coeff(j)*lai(i,j))) ) / lai(i,j)
+                ELSE
+                   resp_maint_part_radia(i,j,k) = zero
+                ENDIF
+             ENDDO ! Loop over # pixels
+          ELSE
+
+             resp_maint_part_radia(:,j,k) = coeff_maint(:,j,k) * biomass(:,j,k,icarbon)
+
+          ENDIF
+
+       ENDDO ! Loop over # plant parts
+
+       ! 3.2 Total maintenance respiration of the plant
+       !     VPP killer:
+       !     resp_maint(:,j) = SUM( resp_maint_part(:,:), DIM=2 )
+
+    ENDDO ! Loop over # PFTs
+
+
+  END SUBROUTINE maint_respiration
+
+END MODULE stomate_resp
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_season.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_season.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_season.f90	(revision 8430)
@@ -0,0 +1,1543 @@
+! =================================================================================================================================
+! MODULE        : stomate_season
+!
+! CONTACT       : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_year, julian_diff, LastTsYear
+
+  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, veget_cov, veget_cov_max, &
+       moiavail_daily, t2m_daily, tsoil_daily, soilhum_daily, lalo,  &
+       precip_daily, npp_daily, biomass, turnover_daily, gpp_daily, when_growthinit, &
+       VPD_daily, VPD_week,swdown_daily, swdown_week, & !!xchen
+       precip_week, & !liulye
+       maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       minmoiavail_lastyear, minmoiavail_thisyear, &
+       maxgppweek_lastyear, maxgppweek_thisyear, &
+       gdd0_lastyear, gdd0_thisyear, &
+       precip_lastyear, precip_thisyear, &
+       lm_lastyearmax, lm_thisyearmax, &
+       maxfpc_lastyear, maxfpc_thisyear, &
+       moiavail_month, moiavail_week, t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+       tsoil_month, soilhum_month, &
+       npp_longterm, turnover_longterm, gpp_week, &
+       gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       time_hum_min, hum_min_dormance, gdd_init_date , & 
+       gdd_from_growthinit, herbivores, &
+       Tseason, Tseason_length, Tseason_tmp, &
+       Tmin_spring_time, t2m_min_daily, begin_leaves, onset_date)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                             :: npts              !! Domain size - number of grid cells (unitless)
+    REAL(r_std), INTENT(in)                                :: dt                !! time step in days (dt_days)
+    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,nslm), INTENT(in)          :: tsoil_daily       !! Daily soil temperature (K)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)          :: soilhum_daily     !! Daily soil humidity (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: lalo              !!  array of lat/lon
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: precip_daily      !! Daily mean precipitation @tex ($mm day^{-1}$) 
+                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: npp_daily         !! daily net primary productivity @tex ($gC m^{-2} 
+                                                                                !! day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: biomass     !! biomass @tex ($gC m^{-2} of ground$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_daily  !! Turnover rates @tex ($gC m^{-2} day^{-1}$) 
+                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: gpp_daily         !! daily gross primary productivity  
+                                                                                !! (Here: @tex $gC m^{-2} of total ground 
+                                                                                !! day^{-1}$) @endtex 
+!! liuly    
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: VPD_daily         !! xchen daily VPD 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: VPD_week          !! xchen daily VPD
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: swdown_daily      !! xchen daily swdown    
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: swdown_week       !! xchen weekly swdown
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_week       !! liulye weekly swdown
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: when_growthinit   !! how many days ago was the beginning of the 
+                                                                                !! growing season (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: begin_leaves      !! signal to start putting leaves on (true/false)
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: t2m_min_daily     !! Daily minimum 2-meter temperature (K)
+
+    !
+    !! 0.2 Output variables 
+    ! (diagnostic)
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)          :: herbivores        !! time constant of probability of a leaf to be 
+                                                                                !! eaten by a herbivore (days) 
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxmoiavail_lastyear      !! last year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxmoiavail_thisyear      !! this year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: minmoiavail_lastyear      !! last year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: minmoiavail_thisyear      !! this year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxgppweek_lastyear       !! last year's maximum weekly GPP 
+                                                                                        !! @tex ($gC m^{-2} week^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxgppweek_thisyear       !! this year's maximum weekly GPP 
+                                                                                        !! @tex ($gC m^{-2} week^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: gdd0_lastyear             !! last year's annual GDD0 (C)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: gdd0_thisyear             !! this year's annual GDD0 (C)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_lastyear           !! last year's annual precipitation 
+                                                                                        !! @tex ($mm year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_thisyear           !! this year's annual precipitation 
+                                                                                        !! @tex ($mm year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: lm_lastyearmax            !! last year's maximum leaf mass, for each 
+                                                                                        !! PFT @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: lm_thisyearmax            !! this year's maximum leaf mass, for each 
+                                                                                        !! PFT @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxfpc_lastyear           !! last year's maximum fpc for each PFT, on 
+                                                                                        !! ground (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxfpc_thisyear           !! this year's maximum fpc for each PFT, on 
+                                                                                        !! ground (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_month            !! "monthly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_week             !! "weekly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_longterm              !! "long term" 2-meter temperatures (K)
+    REAL(r_std), INTENT(inout)                             :: tau_longterm     
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_month                 !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_week                  !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason                   !! "seasonal" 2-meter temperatures (K), 
+                                                                                        !! used to constrain boreal treeline
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason_tmp               !! temporary variable to calculate Tseason 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason_length            !! temporary variable to calculate Tseason: 
+                                                                                        !! number of days when t2m_week is higher than 0 degree 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: Tmin_spring_time          !! Number of days after begin_leaves (leaf onset)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: onset_date                !! Date in the year at when the leaves started to grow(begin_leaves)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(inout)       :: tsoil_month               !! "monthly" soil temperatures (K)
+    REAL(r_std), DIMENSION(npts,nslm), INTENT(inout)       :: soilhum_month             !! "monthly" soil humidity (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: npp_longterm              !! "long term" net primary productivity 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_longterm !! "long term" turnover rate 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gpp_week                  !! "weekly" GPP @tex ($gC m^{-2} day^{-1}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_m5_dormance           !! growing degree days above threshold -5 
+                                                                                        !! deg. C (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_midwinter             !! growing degree days since midwinter (C)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ncd_dormance              !! number of chilling days since leaves 
+                                                                                        !! were lost (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ngd_minus5                !! number of growing days (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: time_hum_min              !! time elapsed since strongest moisture 
+                                                                                        !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: hum_min_dormance          !! minimum moisture during dormance 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(inout)          :: gdd_init_date             !! inital date for gdd count
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_from_growthinit       !! growing degree days, threshold 0 deg. C 
+                                                                                        !! since beginning of season
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                          :: j                        !! indices (unitless)
+    REAL(r_std)                                             :: ncd_max                  !! maximum ncd (to avoid floating point 
+                                                                                        !! underflows) (days) 
+    REAL(r_std), DIMENSION(npts)                            :: sumfpc_nat               !! sum of natural fpcs (0-1, unitless)
+                                                                                        !! [DISPENSABLE] 
+    REAL(r_std), DIMENSION(npts,nvm)                        :: weighttot                !! weight of biomass @tex ($gC m^{-2}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                        :: nlflong_nat              !! natural long-term leaf NPP 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                        :: green_age                !! residence time of green tissue (years)
+    REAL(r_std), DIMENSION(npts)                            :: consumption              !! herbivore consumption 
+                                                                                        !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts)                            :: fracnat                  !! fraction of each gridcell occupied by 
+                                                                                        !! natural vegetation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                            :: solad                    !! maximal radation during current day 
+                                                                                        !! (clear sky condition)
+    REAL(r_std), DIMENSION(npts)                            :: solai                    !! maximal radation during current day
+                                                                                        !! (clear sky condition)
+    REAL(r_std), DIMENSION(npts)                            :: cloud                    !! cloud fraction
+
+!_ =================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering season'
+
+    !
+    !! 1. Initializations
+    !! 1.1 Calculate ::ncd_max - the maximum possible NCD (number of chilling days) as:
+    !!     \latexonly
+    !!     \input{season_ncdmax_eqn2.tex}
+    !!     \endlatexonly
+    !!     \n
+    !!     where one_year is 1 year in seconds (defined in ::constantes).
+    !
+    ncd_max = ncd_max_year * one_year
+
+    IF ( firstcall_season ) THEN
+
+       !
+       !! 1.2 first call - output message giving the setting of the ::gppfrac_dormance,
+       !!     ::hvc1, ::hvc2 and ::leaf_frac (as a percentage) parameters which are 
+       !!     defined at the beginning of this subroutine. Also outputs the value of 
+       !!     ::ncd_max.
+       !
+
+       IF ( printlev>=2 ) 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)
+       IF ( ABS( SUM( moiavail_month(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them it today's moisture availability
+          WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' moisture availabilities. '
+          moiavail_month(:,:) = moiavail_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.1.2 "weekly" (::moiavail_week)
+
+       IF ( ABS( SUM( moiavail_week(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them it today's moisture availability
+          WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' moisture availabilities. '
+          moiavail_week(:,:) = moiavail_daily(:,:)
+
+       ENDIF
+!!xchen
+       IF ( ABS( SUM( VPD_week(:) ) ) .LT. min_stomate ) THEN                   
+                                                                                                      
+        WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' VPD.'
+        VPD_week(:) = VPD_daily(:)                                            
+                                                                              
+     ENDIF
+     IF ( ABS( SUM( swdown_week(:) ) ) .LT. min_stomate ) THEN                
+                                                                                                    
+        WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' swdown.'
+        swdown_week(:) = swdown_daily(:)                                      
+                                                                              
+     ENDIF   
+!! liuly above
+
+!! liulye precip weekly
+     IF ( ABS( SUM( precip_week(:) ) ) .LT. min_stomate ) THEN                
+                                                                                                    
+      WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' precip.'
+      precip_week(:) = precip_daily(:)                                      
+                                                                            
+   ENDIF  
+
+
+       !! 1.3.2 2-meter temperatures:
+
+       !!  "monthly" (::t2m_month)
+       IF ( ABS( SUM( t2m_month(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' 2m temperatures.'
+          t2m_month(:) = t2m_daily(:)
+
+       ENDIF
+
+       !!  "weekly" (::2m_week)
+       IF ( ABS( SUM( t2m_week(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' 2m temperatures.'
+          t2m_week(:) = t2m_daily(:)
+
+       ENDIF
+
+       !! 1.3.3 "monthly" soil temperatures (::tsoil_month):
+       !MM PAS PARALLELISE!!
+       IF ( ABS( SUM( tsoil_month(:,:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning!'// &
+               ' We have to initialize the ''monthly'' soil temperatures.'
+          tsoil_month(:,:) = tsoil_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.4 "monthly" soil humidity (::soilhum_month):
+       IF ( ABS( SUM( soilhum_month(:,:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's humidity
+          WRITE(numout,*) 'Warning!'// &
+               ' We have to initialize the ''monthly'' soil humidity.'
+          soilhum_month(:,:) = soilhum_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.5 growing degree days, threshold -5 deg C (::gdd_m5_dormance):
+       IF ( ABS( SUM( gdd_m5_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Growing degree days (-5 deg) are initialized to ''undef''.'
+          gdd_m5_dormance(:,:) = undef
+       ENDIF
+
+       !! 1.3.6 growing degree days since midwinter (::gdd_midwinter):
+       IF ( ABS( SUM( gdd_midwinter(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Growing degree days since midwinter' // &
+               ' are initialized to ''undef''.'
+          gdd_midwinter(:,:) = undef
+       ENDIF
+
+       !! 1.3.7 number of chilling days since leaves were lost (::ncd_dormance):
+       IF ( ABS( SUM( ncd_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Number of chilling days is initialized to ''undef''.'
+          ncd_dormance(:,:) = undef
+       ENDIF
+
+       !! 1.3.8 number of growing days, threshold -5 deg C (::ngd_minus5):
+       IF ( ABS( SUM( ngd_minus5(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Number of growing days (-5 deg) is initialized to 0.'
+       ENDIF
+
+       !! 1.3.9 "long term" npp (::npp_longterm):
+       IF ( ABS( SUM( npp_longterm(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Long term NPP is initialized to 0.'
+       ENDIF
+
+       !! 1.3.10 "long term" turnover (::turnover_longterm):
+       IF ( ABS( SUM( turnover_longterm(:,2:nvm,:,:) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Long term turnover is initialized to 0.'
+       ENDIF
+
+       !! 1.3.11 "weekly" GPP (::gpp_week):
+       IF ( ABS( SUM( gpp_week(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Weekly GPP is initialized to 0.'
+       ENDIF
+
+       !! 1.3.12 minimum moisture availabilities (::minmoiavail_thisyear)
+       !!        In this case, if the minimum moisture
+       !!        is less than ::min_stomate, the variable is set to ::large_value,
+       !!        which is defined in ::stomate_constants as 1.E33_r_std:
+       IF ( ABS( SUM( minmoiavail_thisyear(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to a very high value
+          WRITE(numout,*) 'Warning! We have to initialize this year''s minimum '// &
+               'moisture availabilities.'
+          minmoiavail_thisyear(:,:) = large_value
+
+       ENDIF
+
+       !
+       !! 1.4 reset firstcall_season flag
+       !
+
+       firstcall_season = .FALSE.
+
+    ENDIF
+
+    ! determine min yearly clear sky radiation (solstice) as beginning for gdd count
+    cloud(:) = zero
+    CALL downward_solar_flux (npts, lalo(:,1),julian_diff,12.,cloud,1,solad,solai)
+
+    WHERE (solad(:) .LT. gdd_init_date(:,2))
+       gdd_init_date(:,1)= julian_diff
+       gdd_init_date(:,2)= solad(:)
+    ENDWHERE
+
+
+    !
+    !! NOTE: Sections 2. to 5. compute slowly-varying, "long-term" (i.e. weekly/monthly)
+    !! input variables using a linear relaxation method, following the equation:
+    !! \latexonly
+    !! \input{season_lin_relax_eqn1.tex}
+    !! \endlatexonly
+    !! \n 
+    !! as described in the introduction to this subroutine (see Krinner et al., 2005).  
+    !! The time constant in the above equation is given for each of the variables
+    !! described.
+    !
+
+    !
+    !! 2. Moisture availability (relative soil moisture, including the root profile) :
+    !!    The time constants (as in the above equation) for these calculations are 
+    !!    given by the parameters ::tau_hum_month (for the monthly
+    !!    calculation) or ::tau_hum_week (for the weekly),
+    !!    which are set in ::stomate_data to be 20 and 7 days respectively.
+    !!    If the moisture availability is less than zero, it is set to zero. 
+    !!    These variables are mostly used in the phenological leaf onset and senescence
+    !!    models in the modules ::stomate_phenology and ::stomate_turnover, 
+    !!    respectively. They are used in models which require a moisture limitation
+    !!    condition. These are the 'hum', 'moi', 'humgdd' and 'moigdd' onset models,
+    !!    and the 'mixed' and 'dry' (weekly only) senescence models. In addition,
+    !!    the weekly moisture availability is used to calculate the limitation
+    !!    on the fraction of NPP allocated to different compartments in the module
+    !!    ::stomate_alloc. 
+    !
+
+    !
+    !! 2.1 "monthly" (::moiavail_month)
+    !
+
+    moiavail_month = ( moiavail_month * ( tau_hum_month - dt ) + &
+         moiavail_daily * dt ) / tau_hum_month
+
+    DO j = 2,nvm  ! Loop over # PFTs
+       WHERE ( ABS(moiavail_month(:,j)) .LT. EPSILON(zero) )
+          moiavail_month(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 2.2 "weekly" (::moiavail_week)
+    !
+
+    moiavail_week = ( moiavail_week * ( tau_hum_week - dt ) + &
+         moiavail_daily * dt ) / tau_hum_week
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(moiavail_week(:,j)) .LT. EPSILON(zero) ) 
+          moiavail_week(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 3. 2-meter temperatures
+    !!    The time constants for the "long-term", "monthly" and "weekly" 2-meter
+    !!    temperatures are given by the parameters ::tau_longterm_max, 
+    !!    ::tau_t2m_month, and ::tau_t2m_week,
+    !!    which are set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!    described above) and 20 and 7 days respectively.
+    !!    If the temperature is less than zero, it is set to zero.
+    !!    In addition the "long term" temperature is written to the history file. \n
+    !!    These variables are used in many different modules of STOMATE. 
+    !!    The longterm t2m is limied to the intervall [tlong_ref_min, tlong_ref_max]
+    !!    using the equation:
+    !!      \latexonly
+    !!      \input{season_t2m_long_ref_eqn3.tex}
+    !!      \endlatexonly
+    !!      \n
+    !!    The "monthly" and "weekly" temperature is used in the modules 
+    !!    ::stomate_phenology and ::stomate_turnover for the onset and senescence 
+    !!    phenological models which require a temperature condition. In addition
+    !!    the "monthly" temperature is used in ::lpj_constraints to determine 
+    !!    the presence and regeneration of the vegetation and in the module
+    !!    ::stomate_assimtemp to calculate photosynthesis temperatures.
+        
+    ! Update tau_longterm
+    tau_longterm = MIN(tau_longterm+dt,tau_longterm_max)
+    
+    ! Recalculate the reference temperature using the old reference temperature and the current temperature
+    t2m_longterm(:) = ( t2m_longterm(:) * ( tau_longterm - dt ) + &
+         t2m_daily(:) * dt ) / tau_longterm
+
+    ! The longterm reference is not allowed to go outside the interval [tlong_ref_min, tlong_ref_max]
+    t2m_longterm(:) = MAX( tlong_ref_min, MIN( tlong_ref_max, t2m_longterm(:) ) )
+
+    CALL xios_orchidee_send_field("t2m_longterm",t2m_longterm)
+
+    CALL histwrite_p (hist_id_stomate, 'T2M_LONGTERM', itime, &
+         t2m_longterm, npts, hori_index)
+
+    !
+    !! 3.3 "monthly" (::t2m_month)
+    !
+
+    t2m_month = ( t2m_month * ( tau_t2m_month - dt ) + &
+         t2m_daily * dt ) / tau_t2m_month
+
+    WHERE ( ABS(t2m_month(:)) .LT. EPSILON(zero) )
+       t2m_month(:) = zero
+    ENDWHERE
+
+    ! Store the day in onset_date when the leaves started grow. julian_diff is the day in the year [1-366].
+    WHERE ( begin_leaves(:,:) )
+       onset_date(:,:)=julian_diff
+    ELSEWHERE
+       onset_date(:,:)=0
+    ENDWHERE
+    
+    ! Calculate "seasonal" temperature
+    WHERE ( t2m_week (:) .GT. ZeroCelsius )
+       Tseason_tmp(:) = Tseason_tmp(:) + t2m_week(:)
+       Tseason_length(:)=Tseason_length(:) + dt
+    ENDWHERE
+
+    ! calculate Tmin in spring (after onset)
+    DO j=1, nvm
+       IF (leaf_tab(j)==1 .AND. pheno_type(j)==2) THEN
+          ! leaf_tab=broadleaf and pheno_typ=summergreen
+          ! Only treat broadleag and summergreen pfts
+          
+          WHERE ( Tmin_spring_time(:,j)>0 .AND. (Tmin_spring_time(:,j)<spring_days_max) )
+             Tmin_spring_time(:,j)=Tmin_spring_time(:,j)+1
+          ELSEWHERE
+             Tmin_spring_time(:,j)=0
+          ENDWHERE
+          
+          WHERE ( begin_leaves(:,j) )
+             Tmin_spring_time(:,j)=1
+          ENDWHERE
+       END IF
+    END DO
+
+    !
+    !! 3.4 "weekly" (::t2m_week)
+    !
+
+    t2m_week = ( t2m_week * ( tau_t2m_week - dt ) + &
+         t2m_daily * dt ) / tau_t2m_week
+
+    WHERE ( ABS(t2m_week(:)) .LT. EPSILON(zero) )
+       t2m_week(:) = zero
+    ENDWHERE
+
+!!xchen weekly VPD and SWdown
+    VPD_week = ( VPD_week * ( tau_t2m_week - dt ) + &                           
+         VPD_daily * dt ) / tau_t2m_week                                        
+                                                                                
+    WHERE ( ABS(VPD_week(:)) .LT. EPSILON(zero) )                               
+       VPD_week(:) = zero                                                       
+    ENDWHERE    
+    swdown_week = ( swdown_week * ( tau_t2m_week - dt ) + &                     
+         swdown_daily * dt ) / tau_t2m_week                                     
+                                                                                
+    WHERE ( ABS(swdown_week(:)) .LT. EPSILON(zero) )                            
+       swdown_week(:) = zero                                                    
+    ENDWHERE  
+!! liuly above
+
+!! liulye
+    precip_week = ( precip_week * ( tau_t2m_week - dt ) + &                     
+         precip_daily * dt ) / tau_t2m_week    
+   
+    WRITE(numout,*) 'Mean ''weekly'' ori pre.', precip_week
+                                                                                
+    WHERE ( ABS(precip_week(:)) .LT. EPSILON(zero) )                            
+       precip_week(:) = zero                                                    
+    ENDWHERE  
+
+    WRITE(numout,*) 'Mean ''weekly'' filtered pre.', precip_week
+    WRITE(numout,*) 'Sum ''weekly'' filtered pre.', precip_week*tau_t2m_week
+
+    
+
+
+    !
+    !! 4. "monthly" soil temperatures (::tsoil_month)
+    !!    The time constant is given by the parameter ::tau_tsoil_month, 
+    !!    which is set in ::stomate_data to be 20 days.
+    !!    If the monthly soil temperature is less than zero, it is set to zero. \n
+    !!    This variable is used in the ::stomate_allocation module.
+    !
+
+    tsoil_month = ( tsoil_month * ( tau_tsoil_month - dt ) + &
+         tsoil_daily(:,:) * dt ) / tau_tsoil_month
+
+    WHERE ( ABS(tsoil_month(:,:)) .LT. EPSILON(zero) )
+       tsoil_month(:,:) = zero
+    ENDWHERE
+
+    !
+    !! 5. ''monthly'' soil humidity (or relative soil moisture - ::soilhum_month) 
+    !!    The time constant is given by the parameter ::tau_soilhum_month, 
+    !!    which is set in ::stomate_data to be 20 days.
+    !!    If the monthly soil humidity is less than zero, it is set to zero.
+    !
+
+    soilhum_month = ( soilhum_month * ( tau_soilhum_month - dt ) + &
+         soilhum_daily * dt ) / tau_soilhum_month
+
+    WHERE ( ABS(soilhum_month(:,:)) .LT. EPSILON(zero) )
+       soilhum_month(:,:) = zero
+    ENDWHERE
+
+    !
+    !! 6. Calculate the dormance time-length (::time_lowgpp).
+    !!    The dormancy time-length is increased by the stomate time step when   
+    !!    the weekly GPP is below one of two thresholds, 
+    !!    OR if the growing season started more than 2 years ago AND the amount of biomass
+    !!    in the carbohydrate reserve is 4 times as much as the leaf biomass.
+    !!    i.e. the plant is declared dormant if it is accumulating carbohydrates but not 
+    !!    using them, so that the beginning of the growing season can be detected .
+    !     This last condition was added by Nicolas Viovy.
+    !!    - NV: special case (3rd condition)
+    !!    Otherwise, set ::time_lowgpp to zero. \n
+    !!    The weekly GPP must be below either the parameter ::min_gpp_allowed, which is set at 
+    !!    the beginning of this subroutine to be 0.3gC/m^2/year, 
+    !!    OR it must be less than last year's maximum weekly GPP multiplied by the
+    !!    maximal ratio of GPP to maximum GPP (::gppfrac_dormance), which is set to 0.2 at the 
+    !!    beginning of this subroutine. \n
+    !!    This variable is used in the ::stomate_phenology module to allow the detection of the
+    !!    beginning of the vegetation growing season for different onset models.
+    !!    Each PFT is looped over.
+    !
+    !NVMODIF
+!!$    DO j = 2,nvm ! Loop over # PFTs
+!!$       WHERE ( ( gpp_week(:,j) .LT. min_gpp_allowed ) .OR. & 
+!!$            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
+!!$            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
+!!$            ( biomass(:,j,icarbres,icarbon) .GT. biomass(:,j,ileaf,icarbon)*4. ) ) )
+!!$          !       WHERE ( ( gpp_week(:,j) .EQ. zero ) .OR. & 
+!!$          !            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
+!!$          !            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
+!!$          !            ( biomass(:,j,icarbres,icarbon) .GT. biomass(:,j,ileaf,icarbon)*4. ) ) )
+!!$       
+!!$          time_lowgpp(:,j) = time_lowgpp(:,j) + dt
+!!$          
+!!$       ELSEWHERE
+!!$          
+!!$          time_lowgpp(:,j) = zero
+!!$
+!!$       ENDWHERE
+!!$    ENDDO
+
+    !
+    !! 7. Calculate the growing degree days (GDD - ::gdd_m5_dormance).
+    !!    This variable is the GDD sum of the temperatures higher than -5 degrees C.
+    !!    It is inititalised to 0 at the beginning of the dormancy period (i.e.
+    !!    when ::time_lowgpp>0), and is set to "undef" when there is GPP 
+    !!    (::time_lowgpp=0), as it is not used during the growing season. \n 
+    !!    ::gdd_m5_dormance is further scaled by (::tau_gdd -dt / ::tau_gdd), 
+    !!    - ::tau_gdd is set to 40. in the module ::stomate_constants. \n
+    !     Nicolas Viovy - not sure why this is...
+    !!    This variable is used in the ::stomate_phenology module for the 
+    !!    'humgdd' and 'moigdd' leaf onset models. \n
+    !!    Each PFT is looped over but ::gdd_m5_dormance is only calculated for 
+    !!    those PFTs for which a critical GDD is defined, i.e. those which are 
+    !!    assigned to the 'humgdd' or 'moigdd' models. \n
+    !!    Finally if GDD sum is less than zero, then it is set to zero. 
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF (.NOT. natural(j)) THEN
+          ! reset counter: start of the growing season
+          WHERE ((when_growthinit(:,j) .EQ. zero))
+	     gdd_from_growthinit(:,j) = zero
+	  ENDWHERE
+          ! increase gdd counter
+          WHERE ( t2m_daily(:) .GT. (ZeroCelsius)  )
+             gdd_from_growthinit(:,j) = gdd_from_growthinit(:,j) + &
+                                 dt * ( t2m_daily(:) - (ZeroCelsius) )
+          ENDWHERE
+       ELSE
+          gdd_from_growthinit(:,j) = undef
+       ENDIF
+
+       ! only for PFTs for which critical gdd is defined
+       ! gdd_m5_dormance is set to 0 at the end of the growing season. It is set to undef
+       ! at the beginning of the growing season.
+
+       IF ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) THEN
+
+          !
+          !! 7.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             gdd_m5_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 7.2 set to undef if there is GPP
+          !
+
+          WHERE ( when_growthinit(:,j) .EQ. zero )
+
+             gdd_m5_dormance(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 7.3 normal update as described above where ::gdd_m5_dormance is defined (not set to "undef").
+          !
+
+          WHERE ( ( t2m_daily(:) .GT. ( ZeroCelsius - gdd_threshold ) ) .AND. &
+               ( gdd_m5_dormance(:,j) .NE. undef )           )
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) + &
+                  dt * ( t2m_daily(:) - ( ZeroCelsius - gdd_threshold ) )
+          ENDWHERE
+
+          WHERE ( gdd_m5_dormance(:,j) .NE. undef ) 
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) * &
+                  ( tau_gdd - dt ) / tau_gdd
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 7.4 Set to zero if GDD is less than zero.
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(gdd_m5_dormance(:,j)) .LT. EPSILON(zero) )
+          gdd_m5_dormance(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 8. Calculate the growing degree days (GDD) since midwinter (::gdd_midwinter)
+    !!    This variable represents the GDD sum of temperatures higher than a PFT-dependent
+    !!    threshold (::ncdgdd_temp), since midwinter.
+    !!    Midwinter is detected if the monthly temperature (::t2m_month) is lower than the weekly 
+    !!    temperature (::t2m_week) AND if the monthly temperature is lower than the long-term 
+    !!    temperature (t2m_longterm). These variables were calculated earlier in this subroutine. \n
+    !!    ::gdd_midwinter is initialised to 0.0 when midwinter is detected, and from then on 
+    !!    increased with each temperature greater than ::ncdgdd_temp, which is defined
+    !!    in the module ::stomate_constants. \n
+    !!    ::gdd_midwinter is set to "undef" when midsummer is detected, following the opposite
+    !!    conditions to those used to define midwinter. \n
+    !!    The variable is used in the ::stomate_phenology module for the leaf onset model 'ncdgdd'.
+    !!    Each PFT is looped over but the ::gdd_midwinter is only calculated for those
+    !!    PFTs for which a critical 'ncdgdd' temperature is defined, i.e. those which are 
+    !!    assigned to the 'ncdgdd' model. \n
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       ! only for PFTs for which ncdgdd_crittemp is defined
+
+       IF ( ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 8.1 set to 0 if undef and if we detect "midwinter"
+          !
+
+!!$          WHERE ( ( gdd_midwinter(:,j) .EQ. undef ) .AND. &
+!!$               ( t2m_month(:) .LT. t2m_week(:) ) .AND. &
+!!$               ( t2m_month(:) .LT. t2m_longterm(:) )    )
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             gdd_midwinter(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 8.2 set to undef if we detect "midsummer"
+          !
+
+          WHERE ( ( t2m_month(:) .GT. t2m_week(:) ) .AND. &
+               ( t2m_month(:) .GT. t2m_longterm(:) )    )
+
+             gdd_midwinter(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 8.3 normal update as described above
+          !
+
+          WHERE ( ( gdd_midwinter(:,j) .NE. undef ) .AND. &
+               ( t2m_daily(:) .GT. ncdgdd_temp(j)+ZeroCelsius ) )
+
+             gdd_midwinter(:,j) = &
+                  gdd_midwinter(:,j) + &
+                  dt * ( t2m_daily(:) - ( ncdgdd_temp(j)+ZeroCelsius ) )
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 9. Calculate the number of chilling days (NCD) since leaves were lost (::ncd_dormance).
+    !!    This variable is initialised to 0 at the beginning of the dormancy period (::time_lowgpp>0)
+    !!    and increased by the stomate time step when the daily temperature is lower than the 
+    !!    PFT-dependent threshold ::ncdgdd_temp, which is defined for each PFT 
+    !!    in a table (::ncdgdd_temp_tab) in the module ::stomate_data. \n
+    !!    It is set to "undef" when there is GPP (::time_lowgpp=0) as it is not needed during
+    !!    the growing season. \n
+    !!    The variable is used in the ::stomate_phenology module for the leaf onset model 'ncdgdd'.
+    !!    Each PFT is looped over but the ::ncd_dormance is only calculated for those
+    !!    PFTs for which a critical 'ncdgdd' temperature is defined, i.e. those which are 
+    !!    assigned to the 'ncdgdd' model.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 9.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             ncd_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 9.2 set to undef if there is GPP
+          !
+
+          WHERE ( when_growthinit(:,j) .EQ. zero )
+
+             ncd_dormance(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 9.3 normal update, as described above, where ::ncd_dormance is defined
+          !
+
+          WHERE ( ( ncd_dormance(:,j) .NE. undef ) .AND. &
+               ( t2m_daily(:) .LE. ncdgdd_temp(j)+ZeroCelsius ) )
+
+             ncd_dormance(:,j) = MIN( ncd_dormance(:,j) + dt, ncd_max )
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 10. Calculate the number of growing days (NGD) since leaves were lost (::ngd_minus5).
+    !!     This variable is initialised to 0 at the beginning of the dormancy period (::time_lowgpp>0)
+    !!     and increased by the stomate time step when the daily temperature is higher than the threshold
+    !!     -5 degrees C. \n    
+    !!     ::ngd_minus5 is further scaled by (::tau_ngd -dt / ::tau_ngd), 
+    !!     - ::tau_ngd is set to 50. in the module ::stomate_constants. \n
+    !      Nicolas Viovy - not sure why this is...
+    !!     The variable is used in the ::stomate_phenology module for the leaf onset model 'ngd'.
+    !!     Each PFT is looped over.
+    !!     If the NGD is less than zero, it is set to zero.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !
+       !! 10.1 Where there is GPP (i.e. ::time_lowgpp=0), set NGD to 0. 
+       !!      This means that we only take into account NGDs when the leaves are off
+       !
+
+       WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+
+       !
+       !! 10.2 normal update, as described above.
+       !
+
+       WHERE ( t2m_daily(:) .GT. (ZeroCelsius - gdd_threshold) )
+          ngd_minus5(:,j) = ngd_minus5(:,j) + dt
+       ENDWHERE
+
+       ngd_minus5(:,j) = ngd_minus5(:,j) * ( tau_ngd - dt ) / tau_ngd
+
+    ENDDO
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(ngd_minus5(:,j)) .LT. EPSILON(zero) )
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 11. Calculate the minimum humidity/relative soil moisture since dormance began (::hum_min_dormance) 
+    !!     and the time elapsed since this minimum (::time_hum_min). \n
+    !!     The minimum moisture availability occurs when the monthly moisture availability, which is updated 
+    !!     daily earlier in this subroutine as previously described, is at a minimum during the dormancy period.
+    !!     Therefore the ::hum_min_dormance is initialised to the monthly moisture availability 
+    !!     at the beginning of the dormancy period (i.e. if it was previously set to undefined and the
+    !!     ::time_lowgpp>0) AND then whenever the monthly moisture availability is less than it has previously
+    !!     been. \n
+    !!     Consequently, the time counter (::time_hum_min) is initialised to 0 at the beginning of the dormancy  
+    !!     period (i.e. if it was previously set to undefined and the ::time_lowgpp>0) AND when the minimum 
+    !!     moisture availability is reached, and is increased by the stomate time step every day throughout
+    !!     the dormancy period. \n
+    !!     ::time_hum_min is used in the ::stomate_phenology module for the leaf onset models 'moi' and 'moigdd'.
+    !!     Each PFT is looped over but the two variables are only calculated for those
+    !!     PFTs for which the critical parameter ::hum_min_time is defined, i.e.   
+    !!     those which are assigned to the 'moi' or 'moigdd' models.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( hum_min_time(j) .NE. undef ) THEN
+
+          !
+          !! 11.1 initialize if undefined and there is no GPP
+          !
+
+          WHERE (when_growthinit(:,j) .EQ. zero)
+
+             time_hum_min(:,j) = zero
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+
+          ENDWHERE
+
+          !
+          !! 11.3 normal update, as described above, where ::time_hum_min and ::hum_min_dormance are defined
+          !
+
+          !! 11.3.1 increase time counter by the stomate time step
+
+          WHERE ( hum_min_dormance(:,j) .NE. undef )
+
+             time_hum_min(:,j) = time_hum_min(:,j) + dt
+
+          ENDWHERE
+
+          !! 11.3.2 set time counter to zero if minimum is reached
+
+          WHERE (( hum_min_dormance(:,j) .NE. undef ) .AND. &
+               ( moiavail_month(:,j) .LE. hum_min_dormance(:,j) ) )
+
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+             time_hum_min(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! NOTE: Sections 12. to 14. compute slowly-varying, "long-term" (i.e. weekly/monthly)
+    !! C fluxes (NPP, turnover, GPP) using the same linear relaxation method as in 
+    !! Sections 2. and 5. and described in the introduction to this section, as given 
+    !! by the following equation:
+    !! \latexonly
+    !! \input{season_lin_relax_eqn1.tex}
+    !! \endlatexonly
+    !! \n 
+    !! The following variables are calculated using the above equation, and the time constant 
+    !! is given for each. 
+    !
+
+    !
+    !! 12. Update the "long term" NPP. (::npp_daily in gC/m^2/day, ::npp_longterm in gC/m^2/year.)
+    !!     The time constant is given by the parameter ::tau_longterm, 
+    !!     which is set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!     described above). If the ::npp_longterm is less than zero then set it to zero. \n
+    !!     ::npp_longterm is used in ::stomate_lpj in the calculation of long-term
+    !!     vegetation dynamics and in ::stomate_lcchange in the calculation of 
+    !!     land cover change. It is also used to calculate diagnose the hebivory activity in 
+    !!     Section 22 of this subroutine.
+    !
+
+    npp_longterm = ( npp_longterm * ( tau_longterm - dt ) + &
+         (npp_daily*one_year) * dt                          ) / &
+         tau_longterm
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(npp_longterm(:,j)) .LT. EPSILON(zero) )
+          npp_longterm(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 13. Update the "long term" turnover rates (in gC/m^2/year).
+    !!     The time constant is given by the parameter ::tau_longterm, 
+    !!     which is set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!     described above). If the ::turnover_longterm is less than zero then set it to zero.\n
+    !!     ::turnover_longterm is used in ::stomate_lpj and :: lpg_gap in the calculation 
+    !!     of long-term vegetation dynamics.
+    !
+
+    turnover_longterm(:,:,:,:) = ( turnover_longterm(:,:,:,:) * ( tau_longterm - dt ) + &
+         (turnover_daily(:,:,:,:)*one_year) * dt                          ) / &
+         tau_longterm
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(turnover_longterm(:,j,:,:)) .LT. EPSILON(zero) )
+          turnover_longterm(:,j,:,:) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 14. Update the "weekly" GPP (where there is vegetation), otherwise set to zero.
+    !!     The time constant is given by the parameter ::tau_gpp_week, 
+    !!     which is set in ::stomate_data to be 7 days. If the ::gpp_week is 
+    !!     less than zero then set it to zero. \n
+    !!     ::gpp_week is used to update the annual maximum weekly GPP (::maxgppweek_thisyear)
+    !!     in Section 16 of this subroutine, which is then used to update the variable
+    !!     ::maxgppweek_lastyear in Section 21 of this subroutine. Both ::gpp_week and 
+    !!     ::maxgppweek_lastyear are used in Section 6 of this subroutine to calculate
+    !!     the onset and time-length of the dormancy period. 
+    !      Note: Used to be weekly GPP divided by veget_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
+
+    !
+    !! 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. biomass(:,j,ileaf,icarbon).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(biomass(:,j,ileaf,icarbon).GT. lm_thisyearmax(:,j)*0.75)
+                   lm_thisyearmax(:,j) = ( lm_thisyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+                        biomass(:,j,ileaf,icarbon) * dt ) / (one_year/leaflife_tab(j))
+                ENDWHERE
+             ELSEWHERE
+                lm_thisyearmax(:,j) =biomass(:,j,ileaf,icarbon)
+             ENDWHERE
+
+          ENDDO
+
+       ELSE
+          
+          !
+          !! 19.3 If LPJ DGVM is not activated but STOMATE is, the maximum leaf mass is set to be the same  
+          !!      as the leaf biomass (::biomass(i,j,ileaf), without a change in the maximum fractional plant cover. 
+          !
+          DO j = 2,nvm ! Loop over # PFTs
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. lm_thisyearmax(:,j) )
+                lm_thisyearmax(:,j) = biomass(:,j,ileaf,icarbon)
+             ENDWHERE
+          ENDDO
+
+       ENDIF !(ok_dgvm)
+    ELSE
+
+          !
+          !! 19.4 If STOMATE is not activated, the maximum leaf biomass is set to be the maximum possible 
+          !!      LAI of the PFT.
+          !
+
+       DO j = 2,nvm ! Loop over # PFTs
+          lm_thisyearmax(:,j) = lai_max(j)  / sla(j)
+       ENDDO
+
+    ENDIF  !(ok_stomate)
+
+    !
+    !! 20. Update the annual maximum fractional plant cover for each PFT if the current fractional cover 
+    !!     (::veget_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
+
+    !
+    !! 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 ( LastTsYear ) 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. min_sechiba )
+          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  ! LastTsYear
+
+    !
+    !! 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. min_sechiba )
+       green_age(:,:) = green_age(:,:) / weighttot(:,:)
+    ELSEWHERE
+       green_age(:,:) = un
+    ENDWHERE
+
+    !
+    !! 22.2 McNaughton et al. (1989) give herbivore consumption as a function of mean, long-term leaf NPP.
+    !!      as it gives an estimate of the edible biomass. The consumption of biomass by herbivores and the 
+    !!      resultant herbivore activity are calculated following the equations:
+    !!      \latexonly
+    !!      \input{season_consumption_eqn4.tex}
+    !!      \endlatexonly
+    !!      \n 
+    !!      and 
+    !!      \latexonly
+    !!      \input{season_herbivore_eqn5.tex}
+    !!      \endlatexonly
+    !!      \n 
+    !       
+
+    DO j = 2,nvm ! Loop over # PFTs
+       !
+       IF ( natural(j) ) THEN
+          !
+          WHERE ( nlflong_nat(:,j) .GT. zero )
+             consumption(:) = hvc1 * nlflong_nat(:,j) ** hvc2
+             herbivores(:,j) = one_year * green_age(:,j) * nlflong_nat(:,j) / consumption(:)
+          ELSEWHERE
+             herbivores(:,j) = 100000.
+          ENDWHERE
+          !
+       ELSE
+          !
+          herbivores(:,j) = 100000.
+          !
+       ENDIF
+       !
+    ENDDO
+    herbivores(:,ibare_sechiba) = zero
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving season'
+
+  END SUBROUTINE season
+
+END MODULE stomate_season
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_soilcarbon.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_soilcarbon.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_soilcarbon.f90	(revision 8430)
@@ -0,0 +1,479 @@
+! =================================================================================================================================
+! MODULE       : stomate_soilcarbon
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Calculate soil dynamics largely following the Century model
+!!	
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_soilcarbon
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE xios_orchidee
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC soilcarbon,soilcarbon_clear
+
+  ! Variables shared by all subroutines in this module
+  
+  LOGICAL, SAVE    :: firstcall_soilcarbon = .TRUE.   !! Is this the first call? (true/false)
+!$OMP THREADPRIVATE(firstcall_soilcarbon)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : soilcarbon_clear
+!!
+!>\BRIEF        Set the flag ::firstcall_soilcarbon to .TRUE. and as such activate sections 1.1.2 and 1.2 of the subroutine soilcarbon 
+!! (see below).
+!! 
+!_ ================================================================================================================================
+  
+  SUBROUTINE soilcarbon_clear
+    firstcall_soilcarbon=.TRUE.
+  ENDSUBROUTINE soilcarbon_clear
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : soilcarbon
+!!
+!>\BRIEF        Computes the soil respiration and carbon stocks, essentially 
+!! following Parton et al. (1987).
+!!
+!! DESCRIPTION	: The soil is divided into 3 carbon pools, with different 
+!! characteristic turnover times : active (1-5 years), slow (20-40 years) 
+!! and passive (200-1500 years).\n
+!! There are three types of carbon transferred in the soil:\n
+!! - carbon input in active and slow pools from litter decomposition,\n
+!! - carbon fluxes between the three pools,\n
+!! - carbon losses from the pools to the atmosphere, i.e., soil respiration.\n
+!!
+!! The subroutine performs the following tasks:\n
+!!
+!! Section 1.\n
+!! The flux fractions (f) between carbon pools are defined based on Parton et 
+!! al. (1987). The fractions are constants, except for the flux fraction from
+!! the active pool to the slow pool, which depends on the clay content,\n
+!! \latexonly
+!! \input{soilcarbon_eq1.tex}
+!! \endlatexonly\n
+!! In addition, to each pool is assigned a constant turnover time.\n
+!!
+!! Section 2.\n
+!! The carbon input, calculated in the stomate_litter module, is added to the 
+!! carbon stock of the different pools.\n
+!!
+!! Section 3.\n
+!! First, the outgoing carbon flux of each pool is calculated. It is 
+!! proportional to the product of the carbon stock and the ratio between the 
+!! iteration time step and the residence time:\n
+!! \latexonly
+!! \input{soilcarbon_eq2.tex}
+!! \endlatexonly
+!! ,\n
+!! Note that in the case of crops, the additional multiplicative factor 
+!! integrates the faster decomposition due to tillage (following Gervois et 
+!! al. (2008)).
+!! In addition, the flux from the active pool depends on the clay content:\n
+!! \latexonly
+!! \input{soilcarbon_eq3.tex}
+!! \endlatexonly
+!! ,\n
+!! Each pool is then cut from the carbon amount corresponding to each outgoing
+!! flux:\n
+!! \latexonly
+!! \input{soilcarbon_eq4.tex}
+!! \endlatexonly\n
+!! Second, the flux fractions lost to the atmosphere is calculated in each pool
+!! by subtracting from 1 the pool-to-pool flux fractions. The soil respiration 
+!! is then the summed contribution of all the pools,\n
+!! \latexonly
+!! \input{soilcarbon_eq5.tex}
+!! \endlatexonly\n
+!! Finally, each carbon pool accumulates the contribution of the other pools:
+!! \latexonly
+!! \input{soilcarbon_eq6.tex}
+!! \endlatexonly
+!!
+!! Section 4.\n
+!! If the flag SPINUP_ANALYTIC is set to true, the matrix A is updated following
+!! Lardy (2011).
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUTS VARIABLE(S): carbon, resp_hetero_soil
+!!
+!! REFERENCE(S)   :
+!! - Parton, W.J., D.S. Schimel, C.V. Cole, and D.S. Ojima. 1987. Analysis of 
+!! factors controlling soil organic matter levels in Great Plains grasslands. 
+!! Soil Sci. Soc. Am. J., 51, 1173-1179.
+!! - Gervois, S., P. Ciais, N. de Noblet-Ducoudre, N. Brisson, N. Vuichard, 
+!! and N. Viovy (2008), Carbon and water balance of European croplands 
+!! throughout the 20th century, Global Biogeochem. Cycles, 22, GB2022, 
+!! doi:10.1029/2007GB003018.
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics[scale=0.5]{soilcarbon_flowchart.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE soilcarbon (npts, clay, &
+       soilcarbon_input, control_temp, control_moist, veget_cov_max, &
+       carbon, resp_hetero_soil, MatrixA)
+
+!! 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,ncarb,nvm), INTENT(in)    :: soilcarbon_input !! Amount of carbon going into the carbon pools from litter decomposition \f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(in)        :: control_temp     !! Temperature control of heterotrophic respiration (unitless: 0->1)
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(in)        :: control_moist    !! Moisture control of heterotrophic respiration (unitless: 0.25->1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)          :: veget_cov_max    !! Fractional coverage: maximum share of the pixel taken by a pft 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)         :: resp_hetero_soil !! Soil heterotrophic respiration \f$(gC m^{-2} (dt_sechiba one_day^{-1})^{-1})$\f
+
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon             !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(inout) :: MatrixA  !! Matrix containing the fluxes between the carbon pools
+                                                                                !! per sechiba time step 
+                                                                                !! @tex $(gC.m^2.day^{-1})$ @endtex
+
+    !! 0.4 Local variables
+    REAL(r_std)                                           :: dt               !! Time step \f$(dt_sechiba one_day^{-1})$\f
+    REAL(r_std), SAVE, DIMENSION(ncarb)                   :: carbon_tau       !! Residence time in carbon pools (days)
+!$OMP THREADPRIVATE(carbon_tau)
+    REAL(r_std), DIMENSION(npts,ncarb,ncarb)              :: frac_carb        !! Flux fractions between carbon pools 
+                                                                              !! (second index=origin, third index=destination) 
+                                                                              !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,ncarb)                    :: frac_resp        !! Flux fractions from carbon pools to the atmosphere (respiration) (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,ncarb,nelements)          :: fluxtot          !! Total flux out of carbon pools \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,ncarb,ncarb,nelements)    :: flux             !! Fluxes between carbon pools \f$(gC m^{2})$\f
+    CHARACTER(LEN=7), DIMENSION(ncarb)                    :: carbon_str       !! Name of the carbon pools for informative outputs (unitless)
+    INTEGER(i_std)                                        :: k,kk,m,j,ij      !! Indices (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,ncarb)                :: decomp_rate_soilcarbon !! Decomposition rate of the soil carbon pools (s) 
+    REAL(r_std), DIMENSION(npts,ncarb)                    :: tsoilpools       !! Diagnostic for soil carbon turnover rate by pool (1/s)
+
+!_ ================================================================================================================================
+
+    !! printlev is the level of diagnostic information, 0 (none) to 4 (full)
+    IF (printlev>=3) WRITE(numout,*) 'Entering soilcarbon' 
+
+!! 1. Initializations
+    dt = dt_sechiba/one_day
+    !! 1.1 Get soil "constants"
+    !! 1.1.1 Flux fractions between carbon pools: depend on clay content, recalculated each time
+    ! From active pool: depends on clay content
+    frac_carb(:,iactive,iactive) = zero
+    frac_carb(:,iactive,ipassive) = frac_carb_ap
+    frac_carb(:,iactive,islow) = un - (metabolic_ref_frac - active_to_pass_clay_frac*clay(:)) - frac_carb(:,iactive,ipassive)
+
+    ! 1.1.1.2 from slow pool
+
+    frac_carb(:,islow,islow) = zero
+    frac_carb(:,islow,iactive) = frac_carb_sa
+    frac_carb(:,islow,ipassive) = frac_carb_sp
+
+    ! From passive pool
+    frac_carb(:,ipassive,ipassive) = zero
+    frac_carb(:,ipassive,iactive) = frac_carb_pa
+    frac_carb(:,ipassive,islow) = frac_carb_ps
+
+    IF ( firstcall_soilcarbon ) THEN
+
+        !! 1.1.2 Residence times in carbon pools (days)
+        carbon_tau(iactive) = carbon_tau_iactive * one_year       ! 1.5 years. This is same as CENTURY. But, in Parton et al. (1987), it's weighted by moisture and temperature dependences.
+        carbon_tau(islow) = carbon_tau_islow * one_year          ! 25 years. This is same as CENTURY. But, in Parton et al. (1987), it's weighted by moisture and temperature dependences.
+        carbon_tau(ipassive) = carbon_tau_ipassive * one_year       ! 1000 years. This is same as CENTURY. But, in Parton et al. (1987), it's weighted by moisture and temperature dependences.
+        
+        !! 1.2 Messages : display the residence times  
+        carbon_str(iactive) = 'active'
+        carbon_str(islow) = 'slow'
+        carbon_str(ipassive) = 'passive'
+        
+        IF (printlev >= 2) THEN
+           WRITE(numout,*) 'soilcarbon:'
+           WRITE(numout,*) '   > minimal carbon residence time in carbon pools (d):'
+           DO k = 1, ncarb ! Loop over carbon pools
+              WRITE(numout,*) '(1, ::carbon_str(k)):',carbon_str(k),' : (1, ::carbon_tau(k)):',carbon_tau(k)
+           ENDDO
+           WRITE(numout,*) '   > flux fractions between carbon pools: depend on clay content'
+        END IF
+        firstcall_soilcarbon = .FALSE.
+        
+    ENDIF
+
+    !! 1.3 Set soil respiration and decomposition rate to zero
+    resp_hetero_soil(:,:) = zero
+    decomp_rate_soilcarbon(:,:,:) = zero
+
+!! 2. Update the carbon stocks with the different soil carbon input
+
+    carbon(:,:,:) = carbon(:,:,:) + soilcarbon_input(:,:,:) * dt
+
+!! 3. Fluxes between carbon reservoirs, and to the atmosphere (respiration) \n
+
+    !! 3.1. Determine the respiration fraction : what's left after
+    ! subtracting all the 'pool-to-pool' flux fractions
+    ! Diagonal elements of frac_carb are zero
+    !    VPP killer:
+    !     frac_resp(:,:) = 1. - SUM( frac_carb(:,:,:), DIM=3 )
+    frac_resp(:,:) = un - frac_carb(:,:,iactive) - frac_carb(:,:,islow) - &
+         frac_carb(:,:,ipassive) 
+
+    !! 3.2. Calculate fluxes
+
+    DO m = 1, nvm ! Loop over # PFTs
+
+      !! 3.2.1. Flux out of pools
+
+      DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
+        
+        ! Determine total flux out of pool
+        ! S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
+        ! Not crop
+         IF ( natural(m) ) THEN
+            fluxtot(:,k,icarbon) = dt/carbon_tau(k) * carbon(:,k,m) * &
+                  control_moist(:,ibelow) * control_temp(:,ibelow)
+
+            decomp_rate_soilcarbon(:,m,k)=dt/carbon_tau(k) * &
+                      control_moist(:,ibelow) * control_temp(:,ibelow)
+         ! C3 crop
+          ELSEIF ( (.NOT. natural(m)) .AND. (.NOT. is_c4(m)) ) THEN
+             fluxtot(:,k,icarbon) = dt/carbon_tau(k) * carbon(:,k,m) * &
+                  control_moist(:,ibelow) * control_temp(:,ibelow) * flux_tot_coeff(1)
+             decomp_rate_soilcarbon(:,m,k)=dt/carbon_tau(k) * &
+                       control_moist(:,ibelow) * control_temp(:,ibelow)*flux_tot_coeff(1)
+          ! C4 Crop   
+          ELSEIF ( (.NOT. natural(m)) .AND. is_c4(m) ) THEN
+             fluxtot(:,k,icarbon) = dt/carbon_tau(k) * carbon(:,k,m) * &
+                  control_moist(:,ibelow) * control_temp(:,ibelow) * flux_tot_coeff(2)
+             decomp_rate_soilcarbon(:,m,k)=dt/carbon_tau(k) * &
+                       control_moist(:,ibelow) *control_temp(:,ibelow)*flux_tot_coeff(2)
+        ENDIF
+        ! END - S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
+
+        ! Carbon flux from active pools depends on clay content
+        IF ( k .EQ. iactive ) THEN
+            fluxtot(:,k,icarbon) = fluxtot(:,k,icarbon) * ( un - flux_tot_coeff(3) * clay(:) )
+            decomp_rate_soilcarbon(:,m,k)=decomp_rate_soilcarbon(:,m,k)* ( un - flux_tot_coeff(3) * clay(:) ) 
+        ENDIF
+        
+        ! Update the loss in each carbon pool
+        carbon(:,k,m) = carbon(:,k,m) - fluxtot(:,k,icarbon)
+        
+        ! Fluxes towards the other pools (k -> kk)
+        DO kk = 1, ncarb ! Loop over the carbon pools where the flux goes
+          flux(:,k,kk,icarbon) = frac_carb(:,k,kk) * fluxtot(:,k,icarbon)
+        ENDDO
+      ENDDO ! End of loop over carbon pools
+      
+      !! 3.2.2 respiration
+      !BE CAREFUL: Here resp_hetero_soil is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_soil is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dt_sechiba/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+      !
+      !       VPP killer:
+      !       resp_hetero_soil(:,m) = SUM( frac_resp(:,:) * fluxtot(:,:), DIM=2 ) / dt
+      
+      resp_hetero_soil(:,m) = &
+         ( frac_resp(:,iactive) * fluxtot(:,iactive,icarbon) + &
+         frac_resp(:,islow) * fluxtot(:,islow,icarbon) + &
+         frac_resp(:,ipassive) * fluxtot(:,ipassive,icarbon)  ) / dt
+      
+      !! 3.2.3 add fluxes to active, slow, and passive pools
+      !       VPP killer:
+      !       carbon(:,:,m) = carbon(:,:,m) + SUM( flux(:,:,:), DIM=2 )
+      
+      DO k = 1, ncarb ! Loop over carbon pools
+        carbon(:,k,m) = carbon(:,k,m) + &
+           flux(:,iactive,k,icarbon) + flux(:,ipassive,k,icarbon) + flux(:,islow,k,icarbon)
+      ENDDO ! Loop over carbon pools
+      
+    ENDDO ! End loop over PFTs
+    
+ !! 4. (Quasi-)Analytical Spin-up
+    
+    !! 4.1.1 Finish to fill MatrixA with fluxes between soil pools
+    
+    IF (spinup_analytic) THEN
+
+       DO m = 2,nvm 
+
+          ! flux leaving the active pool
+          MatrixA(:,m,iactive_pool,iactive_pool) = moins_un * &
+               dt/carbon_tau(iactive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * &
+               ( 1. - flux_tot_coeff(3) * clay(:)) 
+
+          ! flux received by the active pool from the slow pool
+          MatrixA(:,m,iactive_pool,islow_pool) =  frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow)
+
+          ! flux received by the active pool from the passive pool
+          MatrixA(:,m,iactive_pool,ipassive_pool) =  frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) 
+
+          ! flux received by the slow pool from the active pool
+          MatrixA(:,m,islow_pool,iactive_pool) =  frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) ) 
+
+          ! flux leaving the slow pool
+          MatrixA(:,m,islow_pool,islow_pool) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow)
+
+          ! flux received by the passive pool from the active pool
+          MatrixA(:,m,ipassive_pool,iactive_pool) =  frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) )
+
+          ! flux received by the passive pool from the slow pool
+          MatrixA(:,m,ipassive_pool,islow_pool) =  frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow)
+
+          ! flux leaving the passive pool
+          MatrixA(:,m,ipassive_pool,ipassive_pool) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist(:,ibelow) * control_temp(:,ibelow)      
+
+
+          IF ( (.NOT. natural(m)) .AND. (.NOT. is_c4(m)) ) THEN ! C3crop
+
+             ! flux leaving the active pool
+             MatrixA(:,m,iactive_pool,iactive_pool) = MatrixA(:,m,iactive_pool,iactive_pool) * &
+                  flux_tot_coeff(1)  
+
+             ! flux received by the active pool from the slow pool
+             MatrixA(:,m,iactive_pool,islow_pool)= MatrixA(:,m,iactive_pool,islow_pool) * &
+                  flux_tot_coeff(1) 
+
+             ! flux received by the active pool from the passive pool
+             MatrixA(:,m,iactive_pool,ipassive_pool) = MatrixA(:,m,iactive_pool,ipassive_pool) * &
+                  flux_tot_coeff(1)    
+
+             ! flux received by the slow pool from the active pool
+             MatrixA(:,m,islow_pool,iactive_pool) =  MatrixA(:,m,islow_pool,iactive_pool) * &
+                  flux_tot_coeff(1) 
+
+             ! flux leaving the slow pool
+             MatrixA(:,m,islow_pool,islow_pool) = MatrixA(:,m,islow_pool,islow_pool) * &
+                  flux_tot_coeff(1)     
+
+             ! flux received by the passive pool from the active pool
+             MatrixA(:,m,ipassive_pool,iactive_pool) = MatrixA(:,m,ipassive_pool,iactive_pool) * &
+                  flux_tot_coeff(1)
+
+             ! flux received by the passive pool from the slow pool
+             MatrixA(:,m,ipassive_pool,islow_pool) = MatrixA(:,m,ipassive_pool,islow_pool) * &
+                  flux_tot_coeff(1)
+
+             ! flux leaving the passive pool
+             MatrixA(:,m,ipassive_pool,ipassive_pool) =  MatrixA(:,m,ipassive_pool,ipassive_pool) *&
+                  flux_tot_coeff(1)
+
+          ENDIF ! (.NOT. natural(m)) .AND. (.NOT. is_c4(m)) 
+
+
+          IF ( (.NOT. natural(m)) .AND. is_c4(m) ) THEN ! C4crop
+
+             ! flux leaving the active pool
+             MatrixA(:,m,iactive_pool,iactive_pool) = MatrixA(:,m,iactive_pool,iactive_pool) * &
+                  flux_tot_coeff(2)  
+
+            ! flux received by the active pool from the slow pool
+             MatrixA(:,m,iactive_pool,islow_pool)= MatrixA(:,m,iactive_pool,islow_pool) * &
+                  flux_tot_coeff(2) 
+
+             ! flux received by the active pool from the passive pool
+             MatrixA(:,m,iactive_pool,ipassive_pool) = MatrixA(:,m,iactive_pool,ipassive_pool) * &
+                  flux_tot_coeff(2)    
+
+             ! flux received by the slow pool from the active pool
+             MatrixA(:,m,islow_pool,iactive_pool) =  MatrixA(:,m,islow_pool,iactive_pool) * &
+                  flux_tot_coeff(2) 
+
+             ! flux leaving the slow pool
+             MatrixA(:,m,islow_pool,islow_pool) = MatrixA(:,m,islow_pool,islow_pool) * &
+                  flux_tot_coeff(2)     
+
+             ! flux received by the passive pool from the active pool
+             MatrixA(:,m,ipassive_pool,iactive_pool) = MatrixA(:,m,ipassive_pool,iactive_pool) * &
+                  flux_tot_coeff(2)
+
+             ! flux received by the passive pool from the slow pool
+             MatrixA(:,m,ipassive_pool,islow_pool) = MatrixA(:,m,ipassive_pool,islow_pool) * &
+                  flux_tot_coeff(2)
+
+             ! flux leaving the passive pool
+             MatrixA(:,m,ipassive_pool,ipassive_pool) =  MatrixA(:,m,ipassive_pool,ipassive_pool) * &
+                  flux_tot_coeff(2)
+
+          ENDIF ! (.NOT. natural(m)) .AND. is_c4(m) 
+
+          IF (printlev>=4) WRITE(numout,*)'Finish to fill MatrixA'
+
+       ENDDO ! Loop over # PFTS
+
+
+       ! 4.2 Add Identity for each submatrix(7,7) 
+
+       DO j = 1,nbpools
+          MatrixA(:,:,j,j) = MatrixA(:,:,j,j) + un 
+       ENDDO
+
+    ENDIF ! (spinup_analytic)
+
+
+    ! Output diagnostics
+    DO k = 1, ncarb ! Loop over carbon pools
+       DO ij = 1, npts
+          IF (SUM(decomp_rate_soilcarbon(ij,:,k)*veget_cov_max(ij,:)) > min_sechiba) THEN
+             tsoilpools(ij,k) = 1./(SUM(decomp_rate_soilcarbon(ij,:,k)*veget_cov_max(ij,:))/dt_sechiba)
+          ELSE
+             tsoilpools(ij,k) = xios_default_val
+          END IF
+       END DO
+    END DO
+    CALL xios_orchidee_send_field("tSoilPools",tsoilpools)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving soilcarbon'
+    
+  END SUBROUTINE soilcarbon
+
+END MODULE stomate_soilcarbon
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_turnover.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_turnover.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_turnover.f90	(revision 8430)
@@ -0,0 +1,1252 @@
+! =================================================================================================================================
+! MODULE       : stomate_turnover.f90
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module manages the end of the growing season and calculates herbivory and turnover of leaves, fruits, fine roots.
+!! 
+!!\n DESCRIPTION: This subroutine calculates leaf senescence due to climatic conditions or as a 
+!! function of leaf age and new LAI, and subsequent turnover of the different plant biomass compartments (sections 1 to 6), 
+!! herbivory (section 7), fruit turnover for trees (section 8) and sapwood conversion (section 9). 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_turnover
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC turn, turn_clear
+
+  LOGICAL, SAVE                          :: firstcall_turnover = .TRUE.           !! first call (true/false)
+!$OMP THREADPRIVATE(firstcall_turnover)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : turn_clear
+!!
+!>\BRIEF        Set flag ::firstcall_turnover to .TRUE., and therefore activate section 1 
+!!              of subroutine turn which writes a message to the output.
+!!                
+!_ ================================================================================================================================
+
+  SUBROUTINE turn_clear
+    firstcall_turnover=.TRUE.
+  END SUBROUTINE turn_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : turn
+!!
+!>\BRIEF         Calculate turnover of leaves, roots, fruits and sapwood due to aging or climatic 
+!!               induced senescence. Calculate herbivory.
+!!
+!! DESCRIPTION : This subroutine determines the turnover of leaves and fine roots (and stems for grasses)
+!! and simulates following processes:
+!! 1. Mean leaf age is calculated from leaf ages of separate leaf age classes. Should actually 
+!!    be recalculated at the end of the routine, but it does not change too fast. The mean leaf 
+!!    age is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_lma_update_eqn1.tex}
+!!    \endlatexonly
+!!    \n 
+!! 2. Meteorological senescence: the detection of the end of the growing season and shedding 
+!!    of leaves, fruits and fine roots due to unfavourable meteorological conditions.
+!!    The model distinguishes three different types of "climatic" leaf senescence, that do not 
+!!    change the age structure: sensitivity to cold temperatures, to lack of water, or both. 
+!!    If meteorological conditions are fulfilled, a flag ::senescence is set to TRUE. Note
+!!    that evergreen species do not experience climatic senescence.
+!!    Climatic senescence is triggered by sensitivity to cold temperatures where the critical 
+!!    temperature for senescence is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_temp_crit_eqn2.tex}
+!!    \endlatexonly
+!!    \n
+!!    Climatic senescence is triggered by sensitivity to lack of water availability where the 
+!!    moisture availability critical level is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_moist_crit_eqn3.tex}
+!!    \endlatexonly
+!!    \n
+!!    Climatic senescence is triggered by sensitivity to temperature or to lack of water where
+!!    critical temperature and moisture availability are calculated as above.\n
+!!    Trees in climatic senescence lose their fine roots at the same rate as they lose their leaves. 
+!!    The rate of biomass loss of both fine roots and leaves is presribed through the equation:
+!!    \latexonly
+!!    \input{turnover_clim_senes_biomass_eqn4.tex}
+!!    \endlatexonly
+!!    \n
+!!    with ::leaffall(j) a PFT-dependent time constant which is given in 
+!!    ::stomate_constants. In grasses, leaf senescence is extended to the whole plant 
+!!    (all carbon pools) except to its carbohydrate reserve.    
+!! 3. Senescence due to aging: the loss of leaves, fruits and  biomass due to aging
+!!    At a certain age, leaves fall off, even if the climate would allow a green plant
+!!    all year round. Even if the meteorological conditions are favorable for leaf maintenance,
+!!    plants, and in particular, evergreen trees, have to renew their leaves simply because the 
+!!    old leaves become inefficient. Roots, fruits (and stems for grasses) follow leaves. 
+!!    The ??senescence?? rate varies with leaf age. Note that plant is not declared senescent 
+!!    in this case (wchich is important for allocation: if the plant loses leaves because of 
+!!    their age, it can renew them). The leaf turnover rate due to aging of leaves is calculated
+!!    using the following equation:
+!!    \latexonly
+!!    \input{turnover_age_senes_biomass_eqn5.tex}
+!!    \endlatexonly
+!!    \n
+!!    Drop all leaves if there is a very low leaf mass during senescence. After this, the biomass 
+!!    of different carbon pools both for trees and grasses is set to zero and the mean leaf age 
+!!    is reset to zero. Finally, the leaf fraction and leaf age of the different leaf age classes 
+!!    is set to zero. For deciduous trees: next to leaves, also fruits and fine roots are dropped.
+!!    For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected:
+!! 4. Update the leaf biomass, leaf age class fraction and the LAI
+!!    Older leaves will fall more frequently than younger leaves and therefore the leaf age 
+!!    distribution needs to be recalculated after turnover. The fraction of biomass in each 
+!!    leaf class is updated using the following equation:
+!!    \latexonly
+!!    \input{turnover_update_LeafAgeDistribution_eqn6.tex}
+!!    \endlatexonly
+!!    \n
+!! 5. Simulate herbivory activity and update leaf and fruits biomass. Herbivore activity 
+!!    affects the biomass of leaves and fruits as well as stalks (only for grasses).
+!!    However, herbivores do not modify leaf age structure.
+!! 6. Calculates fruit turnover for trees. Trees simply lose their fruits with a time 
+!!    constant ::tau_fruit(j), that is set to 90 days for all PFTs in ::stomate_constants 
+!! 7. Convert sapwood to heartwood for trees and update heart and softwood above and 
+!!    belowground biomass. Sapwood biomass is converted into heartwood biomass 
+!!    with a time constant tau ::tau_sap(j) of 1 year. Note that this biomass conversion 
+!!    is not added to "turnover" as the biomass is not lost. For the updated heartwood, 
+!!    the sum of new heartwood above and new heartwood below after converting sapwood to 
+!!    heartwood, is saved as ::hw_new(:). Creation of new heartwood decreases the age of 
+!!    the plant ??carbon?? with a factor that is determined by: old heartwood ::hw_old(:) 
+!!    divided by the new heartwood ::hw_new(:)
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLES: ::Biomass of leaves, fruits, fine roots and sapwood above (latter for grasses only), 
+!!                        ::Update LAI, ::Update leaf age distribution with new leaf age class fraction 
+!!
+!! REFERENCE(S) : 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199. 
+!! - McNaughton, S. J., M. Oesterheld, D. A. Frank and K. J. Williams (1989), 
+!! Ecosystem-level patterns of primary productivity and herbivory in terrestrial habitats, 
+!! Nature, 341, 142-144, 1989. 
+!! - Sitch, S., C. Huntingford, N. Gedney, P. E. Levy, M. Lomas, S. L. Piao, , Betts, R., Ciais, P., Cox, P., 
+!! Friedlingstein, P., Jones, C. D., Prentice, I. C. and F. I. Woodward : Evaluation of the terrestrial carbon  
+!! cycle, future plant geography and climate-carbon cycle feedbacks using 5 dynamic global vegetation 
+!! models (dgvms), Global Change Biology, 14(9), 2015â2039, 2008. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale=0.5]{turnover_flowchart_1.png}
+!! \includegraphics[scale=0.5]{turnover_flowchart_2.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE turn (npts, dt, PFTpresent, &
+       var_date, dturnover_leaf, laitop, laidow, VPD,ave_VPD, VPD_daily, VPD_week, swdown_week, precip_week,& !!xchen liulye
+       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, lai, biomass, &
+       turnover, senescence,turnover_time)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+
+    INTEGER(i_std), INTENT(in)                                 :: npts                 !! Domain size - number of grid cells 
+                                                                                       !! (unitless) 
+    REAL(r_std), INTENT(in)                                    :: dt                   !! time step (dt_days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                   :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: herbivores           !! time constant of probability of a leaf to 
+                                                                                       !! be eaten by a herbivore (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxmoiavail_lastyear !! last year's maximum moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: minmoiavail_lastyear !! last year's minimum moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week        !! "weekly" moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_month       !! "monthly" moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_longterm         !! "long term" 2 meter reference 
+                                                                                       !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_month            !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_week             !! "weekly" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_cov_max        !! "maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_from_growthinit  !! gdd senescence for crop
+    REAL(r_std), DIMENSION(npts), INTENT(IN)                   :: swdown_week          !!xchen
+    REAL(r_std), DIMENSION(npts), INTENT(IN)                   :: precip_week          !!liulye
+    
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover         !! Turnover @tex ($gC m^{-2}$) @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(out)                  :: senescence           !! is the plant senescent? (true/false) 
+                                                                                       !! (interesting only for deciduous trees: 
+                                                                                       !! carbohydrate reserve) 
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age             !! age of the leaves (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac            !! fraction of leaves in leaf age class 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: age                  !! age (years)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lai                  !! leaf area index @tex ($m^2 m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: turnover_time        !! turnover_time of grasses (days)
+
+!!xchen                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: laitop               !!xchen Wu (science, 2016) sunlit leaf area index @tex ($m^2 m^{-2}$) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: laidow               !!xchen Wu (science 2016) shade leaf area index @tex ($m^2 m^{-2}$) 
+    INTEGER(i_std),INTENT(in)                                  :: var_date             !! xchen Date (days)                           
+!! xchen add vpd for gpp simulation in Amazon                                   
+    REAL(r_std), DIMENSION(npts),     INTENT (in)              :: VPD                  !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(npts),     INTENT(in)               :: VPD_daily            !! xchen Daily VPD
+    REAL(r_std), DIMENSION(npts),     INTENT(in)               :: VPD_week             !! xchen weekly VPD
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: dturnover_leaf       !!xchen1111 Intermediate variable for turnover ?? liulyq
+
+!! liulyc add from xchen
+    REAL(r_std), DIMENSION(npts), INTENT(inout)       :: ave_VPD              !! Vapor Pressure Deficit (kPa)
+
+
+    !! 0.4 Local  variables
+
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_meanage         !! mean age of the leaves (days)
+!! liuly
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_age_cl1         !!@xchen age of the leaves in class 1 (days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_age_cl2         !!@xchen age of the leaves in class 2(days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_age_cl3         !!@xchen age of the leaves in class 3(days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_age_cl4         !!@xchen age of the leaves in class 4(days)
+
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_cl1              !! @xchen to add lai of each leaf class age and for !!calculating PC in wu's science paper
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_cl2                     
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_cl3                     
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_cl4 
+    REAL(r_std), DIMENSION(npts,nvm)                           :: sla_age2           
+    REAL(r_std), DIMENSION(npts,nvm)                           :: sla_age3           
+    REAL(r_std), DIMENSION(npts,nvm)                           :: sla_age4 
+!! liuly above
+    REAL(r_std), DIMENSION(npts,nvm,nleafages)                 :: leaf_turn_frac            !! fraction of leaf class for turn over
+
+
+!! liulya leaf turnover for each cohorts
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_turn_cl1              
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_turn_cl2                     
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_turn_cl3                     
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_turn_cl4 
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_bm_cl1
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_bm_cl2
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_bm_cl3
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_bm_cl4
+   !! liulya leaf fraction of each cohort 20220220
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_fra_cl1         !! liulya fraction of leaves in class 1
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_fra_cl2         !! liulya fraction of leaves in class 2
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_fra_cl3         !! liulya fraction of leaves in class 3
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_fra_cl4         !! liulya fraction of leaves in class 4
+    !! liulya real leaf turnover rate of each cohort 20220220
+    REAL(r_std), DIMENSION(npts,nvm,nleafages)                 :: leaf_turn_rate         !! liulya fraction of leaves in class 1
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_turn_rate_cl1         !! liulya fraction of leaves in class 1
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_turn_rate_cl2         !! liulya fraction of leaves in class 2
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_turn_rate_cl3         !! liulya fraction of leaves in class 3
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_turn_rate_cl4         !! liulya fraction of leaves in class 4
+
+
+    REAL(r_std), DIMENSION(npts)                               :: dturnover            !! Intermediate variable for turnover ??
+                                                                                       !! @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: moiavail_crit        !! critical moisture availability, function 
+                                                                                       !! of last year's moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: tl                   !! long term annual mean temperature, (C)
+    REAL(r_std), DIMENSION(npts)                               :: t_crit               !! critical senescence temperature, function 
+                                                                                       !! of long term annual temperature (K) 
+    LOGICAL, DIMENSION(npts)                                   :: shed_rest            !! shed the remaining leaves? (true/false)
+    REAL(r_std), DIMENSION(npts)                               :: sapconv              !! Sapwood conversion @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: hw_old               !! old heartwood mass @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: hw_new               !! new heartwood mass @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: lm_old               !! old leaf mass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nleafages)                     :: delta_lm             !! leaf mass change for each age class @tex 
+                                                                                       !! ($gC m^{-2}$) @endtex 
+!! liuly
+!! liulyc delta_lm_old seems useless
+    REAL(r_std), DIMENSION(npts,nleafages)                     :: delta_lm_old         !! xxchen1111 leaf mass change for each age class @tex  
+!! REAL(r_std), DIMENSION(npts)                               :: turnover_rate        !! turnover rate (unitless) !!xchen liulya this is ori in tag
+    REAL(r_std), DIMENSION(npts)                               :: turnover_rate2       !! turnover rate (unitless) !!xchen 
+!! liuly above
+    REAL(r_std), DIMENSION(npts)                               :: turnover_rate1       !! turnover rate (unitless) !!xchen 
+    REAL(r_std), DIMENSION(npts)                               :: turnover_rate3       !! turnover rate (unitless) !!liulye
+    REAL(r_std), DIMENSION(npts)                               :: turnover_rate4       !! turnover rate (unitless) !!liulye
+    REAL(r_std), DIMENSION(npts)                               :: temp_lly             !!  temp var for turnover calculation !!liulye
+   !  REAL(r_std), DIMENSION(npts)                               :: turnover_rate_old       !! turnover rate (unitless) !!liulye
+
+!! liulyc
+    REAL(r_std)                                                :: lly_para1           !! temporary for turnover function (unitless) !!liulye
+    REAL(r_std)                                                :: lly_para2           !! temporary for turnover function (unitless) !!liulye
+    REAL(r_std)                                                :: lly_para3           !! temporary for turnover function (unitless) !!liulye
+    REAL(r_std)                                                :: lly_para4           !! temporary for turnover function (unitless) !!liulye
+    REAL(r_std)                                                :: lly_para5           !! temporary for turnover function (unitless) !!liulye
+    REAL(r_std)                                                :: lly_para_fra1           !! temporary for turnover fraction (unitless) !!liulye
+    REAL(r_std)                                                :: lly_para_fra2           !! temporary for turnover fraction (unitless) !!liulye
+    REAL(r_std)                                                :: lly_para_fra3           !! temporary for turnover fraction (unitless) !!liulye
+    REAL(r_std)                                                :: lly_para_fra4           !! temporary for turnover fraction (unitless) !!liulye
+
+    
+    REAL(r_std)                                                :: tmp_date             !! temporary for turnover calculation
+    REAL(r_std)                                                :: left_days             !! temporary for turnover calculation
+    REAL(r_std)                                                :: temp_factor             !! temporary for turnover calculation  no use at present 20220227
+    REAL(r_std)                                                :: scale_factor             !! temporary for turnover calculation
+    REAL(r_std)                                                :: lly_scale_para1             !! temporary for turnover scale
+    REAL(r_std)                                                :: lly_scale_para2             !! temporary for turnover scale
+    REAL(r_std)                                                :: lly_scale_para3             !! temporary for turnover scale
+    REAL(r_std)                                                :: lly_scale_para4             !! temporary for turnover scale
+    REAL(r_std)                                                :: lly_scale_para5             !! temporary for turnover scale
+    REAL(r_std)                                                :: lly_scale_para6             !! temporary for turnover scale
+        !! liuly above
+    REAL(r_std), DIMENSION(npts)                               :: turnover_rate        !! turnover rate (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_age_crit        !! critical leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: new_turnover_time    !! instantaneous turnover time (days)
+    INTEGER(i_std)                                             :: j,m,k                !! Index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering turnover'
+
+    !! 1. first call - output messages
+
+    !! liulyt test for turnover function
+    lly_para1 = turn_sw_para1
+    lly_para2 = turn_sw_para2
+    lly_para3 = turn_sw_para3
+    lly_para4 = turn_sw_para4
+    lly_para5 = turn_sw_para5
+
+   !! liulya for turnover fraction
+    lly_para_fra1 = turn_fra_para1
+    lly_para_fra2 = turn_fra_para2
+    lly_para_fra3 = turn_fra_para3
+    lly_para_fra4 = turn_fra_para4
+
+
+   !! For second half year
+    lly_scale_para1 = turn_scale_para1! 1
+    lly_scale_para2 = turn_scale_para2! 8000
+    lly_scale_para3 = turn_scale_para3! 1.1
+   !! For first half year
+    lly_scale_para4 = turn_scale_para4! 0.5
+    lly_scale_para5 = turn_scale_para5! 8000
+    lly_scale_para6 = turn_scale_para6! 1.1
+
+
+    WRITE(numout,*) 'number of var_days in stomat_turnover: ',var_date
+    tmp_date = var_date
+
+    IF ( tmp_date == 0) THEN
+      tmp_date = 365
+    END IF
+
+    left_days = 365 - tmp_date
+
+    WRITE(numout,*) 'number of tmp_date in stomat_turnover: ',tmp_date
+    WRITE(numout,*) 'number of left_days in stomat_turnover: ',left_days
+
+    IF ( tmp_date > 180 ) THEN
+
+    scale_factor = ((-1 * (tmp_date - 180 - 92) **2) + 8000)/8000 + 1.1
+    WRITE(numout,*) 'scale_factor in stomat_turnover second half year: ',scale_factor
+
+    ELSE
+    scale_factor = 0.5 * ((-1 * (tmp_date - 90) **2) + 8000)/8000 + 1.1
+    WRITE(numout,*) 'scale_factor in stomat_turnover first half year: ',scale_factor
+    END IF
+
+
+   !! liulyc above
+
+    IF ( firstcall_turnover ) THEN
+
+       IF (printlev >=2 ) THEN
+          WRITE(numout,*) 'turnover:'
+          WRITE(numout,*) ' > minimum mean leaf age for senescence (days) (::min_leaf_age_for_senescence) : '&
+               ,min_leaf_age_for_senescence
+       END IF
+       firstcall_turnover = .FALSE.
+
+
+    ENDIF
+
+    !! 2. Initializations 
+
+    !! 2.1 set output to zero
+    turnover(:,:,:,:) = zero
+    new_turnover_time(:,:) = zero
+    senescence(:,:) = .FALSE.
+
+    !! 2.2 Recalculate mean leaf age
+    !      Mean leaf age is recalculated from leaf ages of separate leaf age classes. Should actually be recalculated at the 
+    !      end of this routine, but it does not change too fast.
+    !      The mean leaf age is calculated using the following equation:
+    !      \latexonly
+    !      \input{turnover_lma_update_eqn1.tex}
+    !      \endlatexonly
+    !      \n
+    leaf_meanage(:,:) = zero
+
+    DO m = 1, nleafages
+       leaf_meanage(:,:) = leaf_meanage(:,:) + leaf_age(:,:,m) * leaf_frac(:,:,m)
+    ENDDO
+
+!!@xchen read the leaf_age for 4 classes and output the results             
+    leaf_age_cl1(:,:) = leaf_age(:,:,1)                                         
+    leaf_age_cl2(:,:) = leaf_age(:,:,2)                                         
+    leaf_age_cl3(:,:) = leaf_age(:,:,3)                                         
+    leaf_age_cl4(:,:) = leaf_age(:,:,4) 
+! ! liulya 20210506
+!     leaf_turn_frac(:,:,1) = 0.1
+!     leaf_turn_frac(:,:,2) = 0.2
+!     leaf_turn_frac(:,:,3) = 0.3
+!     leaf_turn_frac(:,:,4) = 0.4
+
+! liulya 20210714
+    leaf_turn_frac(:,:,1) = lly_para_fra1 !!0.7
+    leaf_turn_frac(:,:,2) = lly_para_fra2 !!0.9
+    leaf_turn_frac(:,:,3) = lly_para_fra3 !!1.1
+    leaf_turn_frac(:,:,4) = lly_para_fra4 !!1.3
+
+
+    !! 3. Climatic senescence
+
+    !     Three different types of "climatic" leaf senescence,
+    !     that do not change the age structure. 
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 3.1 Determine if there is climatic senescence. 
+       !      The climatic senescence can be of three types:
+       !      sensitivity to cold temperatures, to lack of water, or both. If meteorological conditions are 
+       !      fulfilled, a flag senescence is set to TRUE.
+       !      Evergreen species do not experience climatic senescence.
+
+       SELECT CASE ( senescence_type(j) )
+
+
+       CASE ('crop' )!for crop senescence is based on a GDD criterium as in crop models
+	  WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( gdd_from_growthinit(:,j) .GT.  gdd_senescence(j)))
+             senescence(:,j) = .TRUE.
+          ENDWHERE
+
+       CASE ( 'cold' )
+
+          !! 3.1.1 Summergreen species: Climatic senescence is triggered by sensitivity to cold temperatures
+          !        Climatic senescence is triggered by sensitivity to cold temperatures as follows: 
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the monthly temperature is low enough (i.e. when monthly temperature ::t2m_month(:) is below a critical 
+          !        temperature ::t_crit(:), which is calculated in this module),
+          !        AND the temperature tendency is negative (i.e. when weekly temperatures ::t2m_week(:) are lower than monthly 
+          !        temperatures ::t2m_month(:))
+          !        If these conditions are met, senescence is set to TRUE.
+          !
+          !        The critical temperature for senescence is calculated using the following equation:
+          !        \latexonly
+          !        \input{turnover_temp_crit_eqn2.tex}
+          !        \endlatexonly
+          !        \n
+          !
+          ! Critical temperature for senescence may depend on long term annual mean temperature
+          tl(:) = t2m_longterm(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + senescence_temp(j,1) + &
+               tl(:) * senescence_temp(j,2) + &
+               tl(:)*tl(:) * senescence_temp(j,3)
+
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) )
+
+             senescence(:,j) = .TRUE.
+
+          ENDWHERE
+
+       CASE ( 'dry' )
+
+          !! 3.1.2 Raingreen species: Climatic senescence is triggered by sensitivity to lack of water availability 
+          !        Climatic senescence is triggered by sensitivity to lack of water availability as follows:  
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the moisture availability drops below a critical level (i.e. when weekly moisture availability 
+          !        ::moiavail_week(:,j) is below a critical moisture availability ::moiavail_crit(:),
+          !        which is calculated in this module), 
+          !        If these conditions are met, senescence is set to TRUE.
+          !
+          !        The moisture availability critical level is calculated using the following equation:
+          !        \latexonly
+          !        \input{turnover_moist_crit_eqn3.tex}
+          !        \endlatexonly
+          !        \n
+          moiavail_crit(:) = &
+               MIN( MAX( minmoiavail_lastyear(:,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
+               senescence_hum(j) ), &
+               nosenescence_hum(j) )
+
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( moiavail_week(:,j) .LT. moiavail_crit(:) ) )
+
+             senescence(:,j) = .TRUE.
+
+          ENDWHERE
+
+       CASE ( 'mixed' )
+
+          !! 3.1.3 Mixed criterion: Climatic senescence is triggered by sensitivity to temperature or to lack of water  
+          !        Climatic senescence is triggered by sensitivity to temperature or to lack of water availability as follows:
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the moisture availability drops below a critical level (i.e. when weekly moisture availability 
+          !        ::moiavail_week(:,j) is below a critical moisture availability ::moiavail_crit(:), calculated in this module), 
+          !        OR 
+          !        the monthly temperature is low enough (i.e. when monthly temperature ::t2m_month(:) is below a critical 
+          !        temperature ::t_crit(:), calculated in this module),
+          !        AND the temperature tendency is negative (i.e. when weekly temperatures ::t2m_week(:) are lower than 
+          !        monthly temperatures ::t2m_month(:)).
+          !        If these conditions are met, senescence is set to TRUE.
+          moiavail_crit(:) = &
+               MIN( MAX( minmoiavail_lastyear(:,j) + hum_frac(j) * &
+               (maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
+               senescence_hum(j) ), &
+               nosenescence_hum(j) )
+
+          tl(:) = t2m_longterm(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + senescence_temp(j,1) + &
+               tl(:) * senescence_temp(j,2) + &
+               tl(:)*tl(:) * senescence_temp(j,3)
+
+          IF ( is_tree(j) ) THEN
+             ! critical temperature for senescence may depend on long term annual mean temperature
+             WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                  ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                  ( ( moiavail_week(:,j) .LT. moiavail_crit(:) ) .OR. &
+                  ( ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) ) ) )
+                senescence(:,j) = .TRUE.
+             ENDWHERE
+          ELSE
+
+            turnover_time(:,j) = max_turnover_time(j)
+
+            WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                 ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                 ( ( moiavail_week(:,j) .LT. moiavail_crit(:) )))
+                turnover_time(:,j) = max_turnover_time(j) * &
+                     (1.-   (1.- (moiavail_week(:,j)/  moiavail_crit(:)))**2)		
+            ENDWHERE
+
+            WHERE ( turnover_time(:,j) .LT. min_turnover_time(j) )		 
+	       turnover_time(:,j) = min_turnover_time(j)			 
+            ENDWHERE 									 
+
+            WHERE ((( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                ((t2m_month(:) .LT. t_crit(:)) .AND. (lai(:,j) .GT. lai_max(j)/4.) .OR. &
+                (t2m_month(:) .LT. ZeroCelsius)) .AND. ( t2m_week(:) .LT. t2m_month(:) )))
+               turnover_time(:,j)= leaffall(j) 
+            ENDWHERE
+            
+         ENDIF
+
+
+       !! Evergreen species do not experience climatic senescence
+       CASE ( 'none' )
+
+          
+       !! In case no climatic senescence type is recognized.
+       CASE default
+
+          WRITE(numout,*) '  turnover: don''t know how to treat this PFT.'
+          WRITE(numout,*) '  number (::j) : ',j
+          WRITE(numout,*) '  senescence type (::senescence_type(j)) : ',senescence_type(j)
+
+          CALL ipslerr_p(3,"turn","Dont know how to treat this PFT.","","")
+
+       END SELECT
+
+       !! 3.2 Drop leaves and roots, plus stems and fruits for grasses
+
+       IF ( is_tree(j) ) THEN
+
+          !! 3.2.1 Trees in climatic senescence lose their fine roots at the same rate as they lose their leaves. 
+          !        The rate of biomass loss of both fine roots and leaves is presribed through the equation:
+          !        \latexonly
+          !        \input{turnover_clim_senes_biomass_eqn4.tex}
+          !        \endlatexonly
+          !        \n
+          !         with ::leaffall(j) a PFT-dependent time constant which is given in ::stomate_constants),
+          WHERE ( senescence(:,j) )
+
+             turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / leaffall(j)
+             turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / leaffall(j)
+
+          ENDWHERE
+
+       ELSE
+
+          !! 3.2.2 In grasses, leaf senescence is extended to the whole plant 
+          !        In grasses, leaf senescence is extended to the whole plant (all carbon pools) except to its
+          !        carbohydrate reserve.      
+
+          IF (senescence_type(j) .EQ. 'crop') THEN
+             ! 3.2.2.1 crops with 'crop' phenological model
+             WHERE ( senescence(:,j) )
+                turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / leaffall(j)
+                turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / leaffall(j)
+                turnover(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) * dt / leaffall(j)
+                turnover(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) * dt /leaffall(j)
+             ENDWHERE
+          ELSE
+          ! 3.2.2.2 grass or crops based on 'mixed' phenological model
+             WHERE (turnover_time(:,j) .LT. max_turnover_time(j)) 
+                turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / turnover_time(:,j)
+                turnover(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) * dt / turnover_time(:,j)
+                turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / turnover_time(:,j) 
+                turnover(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) * dt / turnover_time(:,j)
+             ENDWHERE
+          ENDIF
+       ENDIF      ! tree/grass
+       biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - turnover(:,j,ileaf,icarbon)
+       biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - turnover(:,j,isapabove,icarbon)
+       biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) - turnover(:,j,iroot,icarbon)
+       biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - turnover(:,j,ifruit,icarbon)
+    ENDDO        ! loop over PFTs
+
+    !! 4. Leaf fall
+    !     At a certain age, leaves fall off, even if the climate would allow a green plant
+    !     all year round. Even if the meteorological conditions are favorable for leaf maintenance,
+    !     plants, and in particular, evergreen trees, have to renew their leaves simply because the 
+    !     old leaves become inefficient.   
+    !     Roots, fruits (and stems) follow leaves. The decay rate varies with leaf age.
+    !     Note that plant is not declared senescent in this case (wchich is important for allocation:
+    !     if the plant loses leaves because of their age, it can renew them).
+    !
+    !     The leaf turnover rate due to aging of leaves is calculated using the following equation:
+    !     \latexonly
+    !     \input{turnover_age_senes_biomass_eqn5.tex}
+    !     \endlatexonly
+    !     \n
+!! liulyw xchen modified here as j = 2, 2 for tropical evergreen forest
+         !! liulya 
+         WRITE(numout,*) 'liulyp temp_para1 is:', lly_para1
+         WRITE(numout,*) 'liulyp temp_para2 is:', lly_para2
+         WRITE(numout,*) 'liulyp temp_para3 is:', lly_para3
+         WRITE(numout,*) 'liulyp temp_para4 is:', lly_para4
+         WRITE(numout,*) 'liulyp temp_para5 is:', lly_para5
+         WRITE(numout,*) 'liulyp fra_para1 is:', lly_para_fra1
+         WRITE(numout,*) 'liulyp fra_para2 is:', lly_para_fra2
+         WRITE(numout,*) 'liulyp fra_para3 is:', lly_para_fra3
+         WRITE(numout,*) 'liulyp fra_para4 is:', lly_para_fra4
+          
+   DO j = 2, 2 ! Loop over # PFTs    
+       !! save old leaf mass
+       lm_old(:) = biomass(:,j,ileaf,icarbon)
+
+       !! initialize leaf mass change in age class
+       delta_lm(:,:) = zero
+       delta_lm_old(:,:) = zero !! liulyw here added in chen's code
+
+       IF ( is_tree(j) .OR. (.NOT. natural(j)) ) THEN
+
+          !! 4.1 Trees: leaves, roots, fruits roots and fruits follow leaves.
+
+          !! 4.1.1 Critical age: prescribed for trees
+          leaf_age_crit(:,j) = leafagecrit(j)
+
+       ELSE
+
+          !! 4.2 Grasses: leaves, roots, fruits, sap follow leaves.
+
+          !! 4.2.1 Critical leaf age depends on long-term temperature
+          !        Critical leaf age depends on long-term temperature
+          !        generally, lower turnover in cooler climates.
+          leaf_age_crit(:,j) = &
+               MIN( leafagecrit(j) * leaf_age_crit_coeff(1) , &
+               MAX( leafagecrit(j) * leaf_age_crit_coeff(2) , &
+               leafagecrit(j) - leaf_age_crit_coeff(3) * &
+               ( t2m_longterm(:)-ZeroCelsius - leaf_age_crit_tref ) ) )
+
+       END IF
+          
+       ! 4.2.2 Loop over leaf age classes
+       DO m = 1, nleafages  !!xchen to let the leaf shading only from 2 3 4
+
+          turnover_rate(:) = zero
+          turnover_rate2(:) = zero !! xchen liuly
+          turnover_rate3(:) = zero !! liulye
+
+          WHERE ( leaf_age(:,j,m) .GT. leaf_age_crit(:,j)/2. )
+             turnover_rate(:) =  &
+                  MIN( 0.99_r_std, dt / ( leaf_age_crit(:,j) * &
+                  ( leaf_age_crit(:,j) / leaf_age(:,j,m) )**quatre ) )   
+
+          ENDWHERE
+          !!
+
+         !! xchen set different turnover rate along VPD, leading to                     
+          IF (m .GT. 2) THEN ! GT is greater than while GE is greater and equal
+            WRITE(numout,*) 'Turnover leaf age classes:',m
+            WHERE ((VPD_week(:) .GT. zero) .AND. (lai(:,j) .GT. 2.5))                                
+                turnover_rate1(:) = MIN(MAX((VPD_week(:)/2.0)**3.0*turnover_rate(:),0.0), 0.95)
+            ENDWHERE 
+            !liulyt test litterfall only use vpd
+
+            IF ( tmp_date > 180 ) THEN
+               WRITE(numout,*) 'Entering Scale in second half'
+               WHERE ((swdown_week(:) .GT. zero) .AND. (lai(:,j) .GT. 2.5))
+               ! temp_lly = scale_factor*(EXP(swdown_week(:)/90.0)-1.0)**3.0/2.0
+               temp_lly = scale_factor*(EXP(swdown_week(:)/lly_para1)+lly_para2)**lly_para3/lly_para4
+               turnover_rate2(:) = MIN(MAX(temp_lly*turnover_rate(:),0.0), 0.95)
+               ENDWHERE 
+            ELSE
+               ! WHERE ((swdown_week(:) .GT. zero) .AND. (lai(:,j) .GT. 2.5))
+               ! turnover_rate2(:) = MIN(MAX((EXP(swdown_week(:)/lly_para1)+lly_para2)**lly_para3*turnover_rate(:),0.0), 0.95)
+               ! ENDWHERE
+               WRITE(numout,*) 'Entering First half Scale:'
+               WHERE ((swdown_week(:) .GT. zero) .AND. (lai(:,j) .GT. 2.5))
+               ! temp_lly = scale_factor*(EXP(swdown_week(:)/90.0)-1.0)**3.0/2.0
+               temp_lly = scale_factor*(EXP(swdown_week(:)/lly_para1)+lly_para2)**lly_para3/lly_para4
+               turnover_rate2(:) = MIN(MAX(temp_lly*turnover_rate(:),0.0), 0.95)
+               ENDWHERE 
+            ENDIF
+
+            ! WHERE ((swdown_week(:) .GT. zero) .AND. (lai(:,j) .GT. 2.5))
+            !    !  turnover_rate2(:) = MIN(MAX((EXP(swdown_week(:)/100))**4*turnover_rate(:),0.0), 0.95)
+            !    !  turnover_rate2(:) = MIN(MAX((EXP(swdown_week(:)/180)-1)**6*turnover_rate(:),0.0), 0.95)
+            !    ! turnover_rate2(:) = MIN(MAX((EXP(swdown_week(:)/400)+0.9)**6*turnover_rate(:),0.0), 0.95)
+            !       ! turnover_rate2(:) = MIN(MAX((EXP(swdown_week(:)/110)-4)**4.5*turnover_rate(:),0.0), 0.95)
+            !    turnover_rate2(:) = MIN(MAX((EXP(swdown_week(:)/lly_para1)+lly_para2)**lly_para3*turnover_rate(:),0.0), 0.95)
+            ! ENDWHERE
+            !!liulye test trigger turnover by using precip
+            WHERE ((precip_week(:) .GT. zero) .AND. (lai(:,j) .GT. 2.5))
+                turnover_rate3(:) = MIN(MAX((EXP(precip_week(:)/8)-1)**4*turnover_rate(:),0.0), 0.95)
+            ENDWHERE
+
+            turnover_rate(:) = turnover_rate2(:)
+            WRITE(numout,*) 'turnover_rate:', turnover_rate(:)
+           ENDIF
+           WRITE(numout,*) 'SWdown week:', swdown_week(:)
+
+          leaf_turn_rate(:,j,m) = turnover_rate(:)
+          dturnover(:) = biomass(:,j,ileaf,icarbon) * leaf_frac(:,j,m) * turnover_rate(:) * leaf_turn_frac(:,j,m) ! liulya 20210506 leaf_turn_frac
+          dturnover_leaf(:,j) = dturnover_leaf(:,j) + dturnover(:) !! liulya mod by xchen seems useless
+          turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+
+       !! liulyw blow are in the xchen's code, what use?
+          WHERE (biomass(:,j,ileaf,icarbon) .LE. dturnover(:))
+          dturnover(:) = zero
+          turnover_rate(:) = zero
+         ENDWHERE
+
+         !liulye 
+         turnover_rate4(:) = turnover_rate(:)
+       !! liulyw above 
+         !WRITE(numout,*) 'liulyt dturnover of leaf in turnover is:', dturnover
+
+
+          biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+
+          ! save leaf mass change
+          delta_lm(:,m) = - dturnover(:)
+          
+          dturnover(:) = biomass(:,j,iroot,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+          turnover(:,j,iroot,icarbon) = turnover(:,j,iroot,icarbon) + dturnover(:)
+          biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) - dturnover(:)
+          
+          dturnover(:) = biomass(:,j,ifruit,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+          turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+          biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+          
+          IF (.NOT. is_tree(j)) THEN
+             dturnover(:) = biomass(:,j,isapabove,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+             turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + dturnover(:)
+             biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - dturnover(:)
+          ENDIF
+          
+       ENDDO
+
+       !! 4.3 Recalculate the fraction of leaf biomass in each leaf age class.
+       !      Older leaves will fall more fast than younger leaves and therefore 
+       !      the leaf age distribution needs to be recalculated after turnover. 
+       !      The fraction of biomass in each leaf class is updated using the following equation:
+       !      \latexonly
+       !      \input{turnover_update_LeafAgeDistribution_eqn6.tex}
+       !      \endlatexonly
+       !      \n
+       !
+       !      new fraction = new leaf mass of that fraction / new total leaf mass
+       !                   = (old fraction*old total leaf mass ::lm_old(:) + biomass change of that fraction ::delta_lm(:,m)  ) /
+       !                     new total leaf mass ::biomass(:,j,ileaf
+       DO m = 1, nleafages
+          
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_sechiba )
+             leaf_frac(:,j,m) = ( leaf_frac(:,j,m)*lm_old(:) + delta_lm(:,m) ) / biomass(:,j,ileaf,icarbon)
+          ELSEWHERE
+             leaf_frac(:,j,m) = zero
+          ENDWHERE
+        
+       ENDDO
+       !!liulyw below IF contain in xchen but what to use?
+          IF ( ANY(biomass(1,j,:,icarbon)<0) ) THEN
+            WRITE(numout,*) 'biomass low0 in turnover after leaf fall '
+            WRITE(numout,*) 'biomass(1,j,:,icarbon): ',biomass(1,j,:,icarbon) 
+            WRITE(numout,*) 'turnover(1,j,:,icarbon): ',turnover(1,j,:,icarbon)
+         ENDIF
+       
+    ENDDO         ! loop over PFTs PFT2
+
+
+!! below for PFT3 to end
+   DO j = 3,nvm ! Loop over # PFTs
+
+      !! save old leaf mass
+      lm_old(:) = biomass(:,j,ileaf,icarbon)
+
+      !! initialize leaf mass change in age class
+      delta_lm(:,:) = zero
+
+      IF ( is_tree(j) .OR. (.NOT. natural(j)) ) THEN
+
+         !! 4.1 Trees: leaves, roots, fruits roots and fruits follow leaves.
+
+         !! 4.1.1 Critical age: prescribed for trees
+         leaf_age_crit(:,j) = leafagecrit(j)
+
+      ELSE
+
+         !! 4.2 Grasses: leaves, roots, fruits, sap follow leaves.
+
+         !! 4.2.1 Critical leaf age depends on long-term temperature
+         !        Critical leaf age depends on long-term temperature
+         !        generally, lower turnover in cooler climates.
+         leaf_age_crit(:,j) = &
+              MIN( leafagecrit(j) * leaf_age_crit_coeff(1) , &
+              MAX( leafagecrit(j) * leaf_age_crit_coeff(2) , &
+              leafagecrit(j) - leaf_age_crit_coeff(3) * &
+              ( t2m_longterm(:)-ZeroCelsius - leaf_age_crit_tref ) ) )
+
+      END IF
+         
+      ! 4.2.2 Loop over leaf age classes
+      DO m = 1, nleafages
+
+         turnover_rate(:) = zero
+
+         WHERE ( leaf_age(:,j,m) .GT. leaf_age_crit(:,j)/2. )
+
+            turnover_rate(:) =  &
+                 MIN( 0.99_r_std, dt / ( leaf_age_crit(:,j) * &
+                 ( leaf_age_crit(:,j) / leaf_age(:,j,m) )**quatre ) )
+
+         ENDWHERE
+
+         leaf_turn_rate(:,j,m) = turnover_rate(:)
+         
+         dturnover(:) = biomass(:,j,ileaf,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+         turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+         biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+
+         ! save leaf mass change
+         delta_lm(:,m) = - dturnover(:)
+         
+         dturnover(:) = biomass(:,j,iroot,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+         turnover(:,j,iroot,icarbon) = turnover(:,j,iroot,icarbon) + dturnover(:)
+         biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) - dturnover(:)
+         
+         dturnover(:) = biomass(:,j,ifruit,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+         turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+         biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+         
+         IF (.NOT. is_tree(j)) THEN
+            dturnover(:) = biomass(:,j,isapabove,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+            turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + dturnover(:)
+            biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - dturnover(:)
+         ENDIF
+         
+      ENDDO
+
+      !! 4.3 Recalculate the fraction of leaf biomass in each leaf age class.
+      !      Older leaves will fall more fast than younger leaves and therefore 
+      !      the leaf age distribution needs to be recalculated after turnover. 
+      !      The fraction of biomass in each leaf class is updated using the following equation:
+      !      \latexonly
+      !      \input{turnover_update_LeafAgeDistribution_eqn6.tex}
+      !      \endlatexonly
+      !      \n
+      !
+      !      new fraction = new leaf mass of that fraction / new total leaf mass
+      !                   = (old fraction*old total leaf mass ::lm_old(:) + biomass change of that fraction ::delta_lm(:,m)  ) /
+      !                     new total leaf mass ::biomass(:,j,ileaf
+      DO m = 1, nleafages
+         
+         WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_sechiba )
+            leaf_frac(:,j,m) = ( leaf_frac(:,j,m)*lm_old(:) + delta_lm(:,m) ) / biomass(:,j,ileaf,icarbon)
+         ELSEWHERE
+            leaf_frac(:,j,m) = zero
+         ENDWHERE
+       
+      ENDDO
+      
+   ENDDO         ! loop over PFTs
+
+
+    !! 5. New (provisional) LAI 
+    !     ::lai(:,j) is determined from the leaf biomass ::biomass(:,j,ileaf,icarbon) and the 
+    !     specific leaf surface :: sla(j) (m^2 gC^{-1})
+    !     The leaf area index is updated using the following equation:
+    !     \latexonly
+    !     \input{turnover_update_LAI_eqn7.tex}
+    !     \endlatexonly
+    !     \n
+
+    !    lai(:,ibare_sechiba) = zero
+    !    DO j = 2, nvm ! Loop over # PFTs
+    !        lai(:,j) = biomass(:,j,ileaf,icarbon) * sla(j)
+    !    ENDDO
+
+    !! 6. Definitely drop all leaves if there is a very low leaf mass during senescence.
+
+    !     Both for deciduous trees and grasses same conditions are checked:
+    !     If biomass is large enough (i.e. when it is greater than zero), 
+    !     AND when senescence is set to true
+    !     AND the leaf biomass drops below a critical minimum biomass level (i.e. when it is lower than half
+    !     the minimum initial LAI ::lai_initmin(j) divided by the specific leaf area ::sla(j),
+    !     ::lai_initmin(j) is set to 0.3 in stomate_data.f90 and sla is a constant that is set to 0.015366 m2/gC), 
+    !     If these conditions are met, the flag ::shed_rest(:) is set to TRUE.
+    !
+    !     After this, the biomass of different carbon pools both for trees and grasses is set to zero
+    !     and the mean leaf age is reset to zero.
+    !     Finally, the leaf fraction and leaf age of the different leaf age classes is set to zero.
+    DO j = 2,nvm ! Loop over # PFTs
+
+       shed_rest(:) = .FALSE.
+
+       !! 6.1 For deciduous trees: next to leaves, also fruits and fine roots are dropped 
+       !      For deciduous trees: next to leaves, also fruits and fine roots are dropped: fruit ::biomass(:,j,ifruit) 
+       !      and fine root ::biomass(:,j,iroot) carbon pools are set to zero.
+       IF ( is_tree(j) .AND. ( senescence_type(j) .NE. 'none' ) ) THEN
+
+          ! check whether we shed the remaining leaves
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. senescence(:,j) .AND. &
+               ( biomass(:,j,ileaf,icarbon) .LT. (lai_initmin(j) / 2.)/sla(j) )             )
+
+             shed_rest(:) = .TRUE.
+
+             turnover(:,j,ileaf,icarbon)  = turnover(:,j,ileaf,icarbon) + biomass(:,j,ileaf,icarbon)
+             turnover(:,j,iroot,icarbon)  = turnover(:,j,iroot,icarbon) + biomass(:,j,iroot,icarbon)
+             turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + biomass(:,j,ifruit,icarbon)
+
+             biomass(:,j,ileaf,icarbon)  = zero
+             biomass(:,j,iroot,icarbon)  = zero
+             biomass(:,j,ifruit,icarbon) = zero
+
+             ! reset leaf age and lai
+             leaf_meanage(:,j) = zero
+             lai(:,j) = zero
+          ENDWHERE
+
+       ENDIF
+
+       !! 6.2 For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected: 
+       !      For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected: 
+       !      fruit ::biomass(:,j,ifruit,icarbon), fine root ::biomass(:,j,iroot,icarbon) and sapwood above 
+       !      ::biomass(:,j,isapabove,icarbon) carbon pools are set to zero. 
+       IF ( .NOT. is_tree(j) ) THEN
+
+          ! Shed the remaining leaves if LAI very low.
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. senescence(:,j) .AND. &
+               (  biomass(:,j,ileaf,icarbon) .LT. (lai_initmin(j) / 2.)/sla(j) ))
+
+             shed_rest(:) = .TRUE.
+
+             turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + biomass(:,j,ileaf,icarbon)
+             turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + biomass(:,j,isapabove,icarbon)
+             turnover(:,j,iroot,icarbon) = turnover(:,j,iroot,icarbon) + biomass(:,j,iroot,icarbon)
+             turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + biomass(:,j,ifruit,icarbon)
+
+             biomass(:,j,ileaf,icarbon) = zero
+             biomass(:,j,isapabove,icarbon) = zero
+             biomass(:,j,iroot,icarbon) = zero
+             biomass(:,j,ifruit,icarbon) = zero
+
+             ! reset leaf age and lai 
+             leaf_meanage(:,j) = zero
+             lai(:,j) = zero
+          ENDWHERE
+
+       ENDIF
+
+       !! 6.3 Reset the leaf age structure: the leaf fraction and leaf age of the different leaf age classes is set to zero.
+      
+       DO m = 1, nleafages
+
+          WHERE ( shed_rest(:) )
+
+             leaf_age(:,j,m) = zero
+             leaf_frac(:,j,m) = zero
+
+          ENDWHERE
+
+       ENDDO
+
+    ENDDO          ! loop over PFTs
+    
+    !! 7. Herbivore activity: elephants, cows, gazelles but no lions.
+ 
+    !     Herbivore activity affects the biomass of leaves and fruits as well 
+    !     as stalks (only for grasses). Herbivore activity does not modify leaf 
+    !     age structure. Herbivores ::herbivores(:,j) is the time constant of 
+    !     probability of a leaf to be eaten by a herbivore, and is calculated in 
+    !     ::stomate_season. following Mc Naughton et al. [1989].
+
+    IF ( ok_herbivores ) THEN
+
+       ! If the herbivore activity is allowed (if ::ok_herbivores is true, which is set in run.def), 
+       ! remove the amount of biomass consumed by herbivory from the leaf biomass ::biomass(:,j,ileaf,icarbon) and 
+       ! the fruit biomass ::biomass(:,j,ifruit,icarbon).
+       ! The daily amount consumed equals the biomass multiplied by 1 day divided by the time constant ::herbivores(:,j).
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( is_tree(j) ) THEN
+
+             !! For trees: only the leaves and fruit carbon pools are affected
+
+             WHERE (biomass(:,j,ileaf,icarbon) .GT. zero)
+                ! added by shilong
+                WHERE (herbivores(:,j).GT. min_sechiba)
+                   dturnover(:) = biomass(:,j,ileaf,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+                   biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,ifruit,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+                   biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+                ENDWHERE
+             ENDWHERE
+
+          ELSE
+
+             ! For grasses: all aboveground carbon pools are affected: leaves, fruits and sapwood above
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. zero )
+                ! added by shilong
+                WHERE (herbivores(:,j) .GT. min_sechiba)
+                   dturnover(:) = biomass(:,j,ileaf,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+                   biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,isapabove,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + dturnover(:)
+                   biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,ifruit,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+                   biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+                ENDWHERE
+
+             ENDWHERE
+
+          ENDIF  ! tree/grass?
+
+       ENDDO    ! loop over PFTs
+
+    ENDIF ! end herbivores
+
+    !! 8. Fruit turnover for trees
+
+    !     Fruit turnover for trees: trees simply lose their fruits with a time constant ::tau_fruit(j), 
+    !     that is set to 90 days for all PFTs in ::stomate_constants
+
+    DO k = 1,nelements 
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( is_tree(j) ) THEN
+
+             dturnover(:) = biomass(:,j,ifruit,k) * dt / tau_fruit(j)
+             turnover(:,j,ifruit,k) = turnover(:,j,ifruit,k) + dturnover(:)
+             biomass(:,j,ifruit,k) = biomass(:,j,ifruit,k) - dturnover(:)
+             
+          ENDIF
+       ENDDO       ! loop over PFTs
+    END DO
+
+    !! 9 Conversion of sapwood to heartwood both for aboveground and belowground sapwood and heartwood.
+
+    !   Following LPJ (Sitch et al., 2003), sapwood biomass is converted into heartwood biomass 
+    !   with a time constant tau ::tau_sap(j) of 1 year.
+    !   Note that this biomass conversion is not added to "turnover" as the biomass is not lost!
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( is_tree(j) ) THEN
+
+          !! For the recalculation of age in 9.2 (in case the vegetation is not dynamic ie. ::ok_dgvm is FALSE), 
+          !! the heartwood above and below is stored in ::hw_old(:).
+          IF ( .NOT. ok_dgvm ) THEN
+             hw_old(:) = biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon)
+          ENDIF
+
+          !! 9.1 Calculate the rate of sapwood to heartwood conversion 
+          !      Calculate the rate of sapwood to heartwood conversion with the time constant ::tau_sap(j) 
+          !      and update aboveground and belowground sapwood ::biomass(:,j,isapabove) and ::biomass(:,j,isapbelow)
+          !      and heartwood ::biomass(:,j,iheartabove) and ::biomass(:,j,iheartbelow).
+
+          DO k = 1,nelements
+
+             ! Above the ground
+             sapconv(:) = biomass(:,j,isapabove,k) * dt / tau_sap(j)
+             biomass(:,j,isapabove,k) = biomass(:,j,isapabove,k) - sapconv(:)
+             biomass(:,j,iheartabove,k) =  biomass(:,j,iheartabove,k) + sapconv(:)
+             
+             ! Below the ground
+             sapconv(:) = biomass(:,j,isapbelow,k) * dt / tau_sap(j)
+             biomass(:,j,isapbelow,k) = biomass(:,j,isapbelow,k) - sapconv(:)
+             biomass(:,j,iheartbelow,k) =  biomass(:,j,iheartbelow,k) + sapconv(:)
+
+          END DO
+
+          !! 9.2 If the vegetation is not dynamic, the age of the plant is decreased. 
+          !      The updated heartwood, the sum of new heartwood above and new heartwood below after 
+          !      converting sapwood to heartwood, is saved as ::hw_new(:) .
+          !      Creation of new heartwood decreases the age of the plant with a factor that is determined by: 
+          !      old heartwood ::hw_old(:) divided by the new heartwood ::hw_new(:)
+          IF ( .NOT. ok_dgvm ) THEN
+
+             hw_new(:) = biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon)
+
+             WHERE ( hw_new(:) .GT. min_sechiba )
+
+                age(:,j) = age(:,j) * hw_old(:)/hw_new(:)
+
+             ENDWHERE
+
+          ENDIF
+
+       ENDIF
+
+    ENDDO       ! loop over PFTs
+
+
+    CALL xios_orchidee_send_field("HERBIVORES",herbivores)
+    CALL xios_orchidee_send_field("LEAF_AGE",leaf_meanage)
+!!@xchen add output fields 
+    CALL xios_orchidee_send_field("LEAF_AGE_CL1",leaf_age_cl1)                  
+    CALL xios_orchidee_send_field("LEAF_AGE_CL2",leaf_age_cl2)                  
+    CALL xios_orchidee_send_field("LEAF_AGE_CL3",leaf_age_cl3)                  
+    CALL xios_orchidee_send_field("LEAF_AGE_CL4",leaf_age_cl4)
+!! liulye liulyt
+   !  CALL xios_orchidee_send_field("Turnover_rate_ori",turnover_rate_old)
+   !  CALL xios_orchidee_send_field("Turnover_rate_vpd",turnover_rate1)
+   !  CALL xios_orchidee_send_field("Turnover_rate_sw",turnover_rate2)
+   !  CALL xios_orchidee_send_field("Turnover_rate_pre",turnover_rate3)
+   !  CALL xios_orchidee_send_field("Turnover_rate_final",turnover_rate4)
+    CALL xios_orchidee_send_field("Pre_weekly",precip_week)
+    CALL xios_orchidee_send_field("SWdown_weekly",swdown_week)
+    CALL xios_orchidee_send_field("VPD_weekly",VPD_week)
+    
+
+
+
+!! liulyc code based on xchen, sla_max -> sla
+   DO j = 2,nvm                                                                
+      sla_age2(:,j) = sla(j)*0.9                                           
+      sla_age3(:,j) = sla(j)*0.85                                          
+      sla_age4(:,j) = sla(j)*0.8                                           
+   ENDDO                                                                       
+   lai_cl2(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,2)*sla_age2(:,:)    
+   lai_cl3(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,3)*sla_age3(:,:)    
+   lai_cl4(:,:) = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,4)*sla_age4(:,:)    
+   lai_cl1(:,:) = lai(:,:) - lai_cl2(:,:) -lai_cl3(:,:) -lai_cl4(:,:)          
+   CALL xios_orchidee_send_field("LAI_CL1",lai_cl1(:,:))                       
+   CALL xios_orchidee_send_field("LAI_CL2",lai_cl2(:,:))                       
+   CALL xios_orchidee_send_field("LAI_CL3",lai_cl3(:,:))                       
+   CALL xios_orchidee_send_field("LAI_CL4",lai_cl4(:,:))
+!! liulyc above  
+
+!! liulya  Leaf biomass CL 1 - 4
+   leaf_bm_cl2 = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,2)
+   leaf_bm_cl3 = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,3)
+   leaf_bm_cl4 = biomass(:,:,ileaf,icarbon)*leaf_frac(:,:,4)
+   leaf_bm_cl1 = biomass(:,:,ileaf,icarbon) - leaf_bm_cl2(:,:)- leaf_bm_cl3(:,:)- leaf_bm_cl4(:,:)
+
+   CALL xios_orchidee_send_field("LEAF_BM_CL1",leaf_bm_cl1(:,:))
+   CALL xios_orchidee_send_field("LEAF_BM_CL2",leaf_bm_cl2(:,:))
+   CALL xios_orchidee_send_field("LEAF_BM_CL3",leaf_bm_cl3(:,:))
+   CALL xios_orchidee_send_field("LEAF_BM_CL4",leaf_bm_cl4(:,:))
+
+
+!! liulya 20201003
+   leaf_turn_cl2(:,:) = dturnover_leaf(:,:)*leaf_frac(:,:,2)
+   leaf_turn_cl3(:,:) = dturnover_leaf(:,:)*leaf_frac(:,:,3)
+   leaf_turn_cl4(:,:) = dturnover_leaf(:,:)*leaf_frac(:,:,4)
+   leaf_turn_cl1(:,:) = dturnover_leaf(:,:)-leaf_turn_cl2(:,:)-leaf_turn_cl3(:,:)-leaf_turn_cl4(:,:)
+   CALL xios_orchidee_send_field("LEAF_TURN_Total_lly",dturnover_leaf(:,:))
+   CALL xios_orchidee_send_field("LEAF_TURN_CL1",leaf_turn_cl1(:,:))                       
+   CALL xios_orchidee_send_field("LEAF_TURN_CL2",leaf_turn_cl2(:,:))                       
+   CALL xios_orchidee_send_field("LEAF_TURN_CL3",leaf_turn_cl3(:,:))                       
+   CALL xios_orchidee_send_field("LEAF_TURN_CL4",leaf_turn_cl4(:,:))
+   !! liulya 20220220
+   leaf_turn_rate_cl1 = leaf_turn_rate(:,:,1) 
+   leaf_turn_rate_cl2 = leaf_turn_rate(:,:,2) 
+   leaf_turn_rate_cl3 = leaf_turn_rate(:,:,3) 
+   leaf_turn_rate_cl4 = leaf_turn_rate(:,:,4) 
+   CALL xios_orchidee_send_field("LEAF_TURN_RATE_CL1",leaf_turn_rate_cl1(:,:))
+   CALL xios_orchidee_send_field("LEAF_TURN_RATE_CL2",leaf_turn_rate_cl2(:,:))
+   CALL xios_orchidee_send_field("LEAF_TURN_RATE_CL3",leaf_turn_rate_cl3(:,:))
+   CALL xios_orchidee_send_field("LEAF_TURN_RATE_CL4",leaf_turn_rate_cl4(:,:))
+
+   leaf_fra_cl1 = leaf_frac(:,:,1)
+   leaf_fra_cl2 = leaf_frac(:,:,2)
+   leaf_fra_cl3 = leaf_frac(:,:,3)
+   leaf_fra_cl4 = leaf_frac(:,:,4)
+   CALL xios_orchidee_send_field("LEAF_Frac_CL1",leaf_fra_cl1(:,:))
+   CALL xios_orchidee_send_field("LEAF_Frac_CL2",leaf_fra_cl2(:,:))
+   CALL xios_orchidee_send_field("LEAF_Frac_CL3",leaf_fra_cl3(:,:))
+   CALL xios_orchidee_send_field("LEAF_Frac_CL4",leaf_fra_cl4(:,:))
+
+
+    ! Write mean leaf age and time constant of probability of a leaf to be eaten by a herbivore 
+    ! to the stomate output file.
+    CALL histwrite_p (hist_id_stomate, 'LEAF_AGE', itime, &
+         leaf_meanage, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HERBIVORES', itime, &
+         herbivores, npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving turnover'
+
+  END SUBROUTINE turn
+
+END MODULE stomate_turnover
Index: /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_vmax.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_vmax.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_vmax.f90	(revision 8430)
@@ -0,0 +1,392 @@
+! =================================================================================================================================
+! MODULE 	: stomate_vmax
+!
+! CONTACT	: orchidee-help _at_ listes.ipsl.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, vcmax_cl1,vcmax_cl2,vcmax_cl3,vcmax_cl4, VPD_week, ave_VPD) !!xchen
+
+    !
+    !! 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
+
+    !! liuly
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax_cl1               !! @xchen  Maximum rate of carboxylation
+                                                                                          !! for leaf age 1
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax_cl2               !! leaf age 2 
+                                                                                          !! 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax_cl3               !! leaf age 3 
+                                                                                          !! 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax_cl4               !! leaf age 4
+                                                                                          !! unit ($\mu mol m^{-2} s^{-1}$)  
+    REAL(r_std), DIMENSION(npts),     INTENT(in)               :: VPD_week                !! xchen weekly VPD
+    REAL(r_std), DIMENSION(npts),     INTENT(inout)            :: ave_VPD                 !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(npts)                               :: ave_VPD_old             !! Vapor Pressure Deficit (kPa)
+
+!! liuly above
+
+    !
+    !! 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
+       
+       IF (printlev >= 2) 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
+       END IF
+       firstcall_vmax = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    vcmax(:,:) = zero
+
+    !!xchen
+    ave_VPD_old = MAX(2.0, VPD_week)                                           
+    ave_VPD_old = LOG(ave_VPD_old)*LOG(ave_VPD_old)*LOG(ave_VPD_old) 
+
+    !
+    !! 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
+       !! xchen liuly
+       vcmax_cl1(:,j) = zero                                                        
+       vcmax_cl2(:,j) = zero                                                        
+       vcmax_cl3(:,j) = zero                                                        
+       vcmax_cl4(:,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)
+!! liuly
+          vcmax_cl1(:,j) = Vcmax25(j)                                                    
+          vcmax_cl2(:,j) = Vcmax25(j)                                                    
+          vcmax_cl3(:,j) = Vcmax25(j)                                                    
+          vcmax_cl4(:,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)
+!! liulyc liulyw  
+             IF (m .EQ. 1) THEN                                                   
+               vcmax_cl1(:,j) = vcmax_cl1(:,j) + Vcmax25(j) *leaf_efficiency(:)
+             ELSE If (m .EQ. 2) THEN                                              
+               vcmax_cl2(:,j) = vcmax_cl2(:,j) + Vcmax25(j) *leaf_efficiency(:)
+             ELSE If (m .EQ. 3) THEN                                             
+               vcmax_cl3(:,j) = vcmax_cl3(:,j) + Vcmax25(j) *leaf_efficiency(:)
+             ELSE                                                            
+               vcmax_cl4(:,j) = vcmax_cl4(:,j) + Vcmax25(j) *leaf_efficiency(:)
+             ENDIF
+!! liulyc liulyw  above
+             
+          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-AFP/src_stomate/stomate_woodharvest.f90
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_woodharvest.f90	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_stomate/stomate_woodharvest.f90	(revision 8430)
@@ -0,0 +1,206 @@
+! =================================================================================================================================
+! MODULE       : stomate_woodharvest
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.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/trunk/ORCHIDEE/src_stomate/stomate_woodharvest.f90 $
+!! $Date: 2016-01-06 13:15:53 +0100 (mer. 06 janv. 2016) $
+!! $Revision: 3094 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_woodharvest
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC woodharvest_main
+  
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : woodharvest_main
+!!
+!>\BRIEF        Impact of wood harvest on carbon stocks
+!!
+!! DESCRIPTION  : This subroutine is always activate if DO_WOOD_HARVEST=y in the configuration file.
+!! woodharvest_main is called from stomateLpj every year (at the beginning)
+!! The impact of wood harvest on carbon stocks is computed in this subroutine. The land cover change is written
+!! by the difference of current and previous "maximal" coverage fraction of a PFT. 
+!! On the basis of this difference, the amount of 'new establishment'/'biomass export',
+!! and increase/decrease of each component, are estimated.\n
+!!
+!! Main structure of woodharvest is:
+!! 1. Initialization
+!! 2. Calculation of changes in carbon stocks and biomass by wood harvest
+!! 3. Update 10 year- and 100 year-turnover pool contents
+!! 4. History
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::prod10, ::prod100, ::flux10, ::flux100,
+!!   :: cflux_prod10 and :: cflux_prod100 
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  
+  SUBROUTINE woodharvest_main ( npts, dt_days, veget_max_old, &
+       biomass, &        
+       flux10_harvest,flux100_harvest, prod10_harvest,prod100_harvest,&
+       convflux_harvest,cflux_prod10_harvest,cflux_prod100_harvest,&
+       harvestwood,harvestpft,fHarvestToProduct)
+    
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER, INTENT(in)                            :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                        :: dt_days          !! Time step of vegetation dynamics for stomate (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)   :: veget_max_old    !! Current "maximal" coverage fraction of a PFT (LAI
+                                                                       !! -> infinity) on ground
+    REAL(r_std), DIMENSION(npts), INTENT(in)       :: harvestwood      !! Harvested wood biomass (gC m-2 yr-1)
+ 
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts), INTENT(out)      :: convflux_harvest        !! flux release during first year following wood harvest
+    REAL(r_std), DIMENSION(npts), INTENT(out)      :: cflux_prod10_harvest    !! total annual release from the 10 year-turnover
+                                                                              !! pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts), INTENT(out)      :: cflux_prod100_harvest   !! total annual release from the 100 year-
+                                                                              !! turnover pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)  :: harvestpft              !! wood harvested for each PFT
+                                                                              !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)  :: fHarvestToProduct       !!  Harvested biomass into product pool due to anthorpogenic 
+                                                                              !! land use (gC m-2 )
+!! 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,0:10), INTENT(inout)  :: prod10_harvest  !! products remaining in the 10/100 year-turnover pool 
+                                                                         !! after the annual release for each compartment
+                                                                         !! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100_harvest !! see prod10_havest
+    REAL(r_std), DIMENSION(npts,10), INTENT(inout)    :: flux10_harvest  !! annual release from the 10 year-turnover pool compartments
+
+    REAL(r_std), DIMENSION(npts,100), INTENT(inout)   :: flux100_harvest !! annual release from the 100 year-turnover pool compartments
+                                                   
+    !! 0.4 Local variables
+
+    INTEGER(i_std)            :: i, j, l, m    !! indices (unitless)
+    REAL(r_std)               :: harvest       !! wood harvest renomalized by forest fraction
+    REAL(r_std)               :: relharvest    !! relative harvest fraction of each pft 
+    REAL(r_std)               :: relbiomass    !! relative biomass of each PFT 
+    REAL(r_std)               :: vegettree     !! vegfrac of trees
+    REAL(r_std)               :: abovemean     !! mean aboveground biomass @tex ($gC m^{-2}$) @endtex
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering woodharvest_main'
+    
+  !! 1. initialization
+    
+    !! 2. calculation of changes in carbon stocks and biomass by wood harvest \n
+    !! 2.1 initialization of carbon stocks\n
+    prod10_harvest(:,0)           = zero
+    prod100_harvest(:,0)          = zero   
+    convflux_harvest(:)           = zero
+    cflux_prod10_harvest(:)       = zero
+    cflux_prod100_harvest(:)      = zero
+    harvestpft(:,:)               = zero
+
+    fHarvestToProduct(:,:)        = zero
+
+    DO i = 1, npts  
+       abovemean=0          
+       vegettree=0
+       !! 2.3 calculation of total forest fraction and mean biomass
+       DO j=1, nvm
+          if (is_tree(j)) THEN
+             abovemean=abovemean+((biomass(i,j,iheartabove,icarbon)+biomass(i,j,isapabove,icarbon)))*veget_max_old(i,j)
+             vegettree=vegettree+veget_max_old(i,j)
+          ENDIF
+       ENDDO
+       IF (vegettree > min_stomate) THEN
+          
+          harvest=harvestwood(i) 
+          abovemean=abovemean/vegettree
+
+          !! 2.4 wood harvest for each PFT is estimated proportionally to the relative biomass.
+          DO j=1,nvm
+             relharvest=0
+             IF ((is_tree(j)) .AND. (abovemean > min_stomate)  .AND. &
+                  (biomass(i,j,iheartabove,icarbon)+biomass(i,j,isapabove,icarbon)>min_stomate))  THEN
+                relbiomass=((biomass(i,j,iheartabove,icarbon)+biomass(i,j,isapabove,icarbon))/abovemean) 
+                relharvest=harvest*relbiomass
+
+                !! 2.5 the harvest could not be higher than 20% of the biomasse to avoid rapid killing of vegetation
+                IF ((biomass(i,j,iheartabove,icarbon)+biomass(i,j,isapabove,icarbon))*0.2<relharvest) &
+                     relharvest=(biomass(i,j,iheartabove,icarbon)+biomass(i,j,isapabove,icarbon))*0.2; 
+                biomass(i,j,iheartabove,:)= biomass(i,j,iheartabove,:) - &
+                     relharvest*(biomass(i,j,iheartabove,:)/(biomass(i,j,iheartabove,:)+biomass(i,j,isapabove,:)))
+                biomass(i,j,isapabove,:)= biomass(i,j,isapabove,:) - &
+                     relharvest*(biomass(i,j,isapabove,:)/(biomass(i,j,iheartabove,:)+biomass(i,j,isapabove,:)))
+
+                fHarvestToProduct(i,j)=relharvest*veget_max_old(i,j)
+                ! 2.6 calculation of different flux like for LU
+                convflux_harvest(i)  = convflux_harvest(i) +coeff_lcchange_1(j)*relharvest*veget_max_old(i,j)
+                harvestpft(i,j)=relharvest*dt_days/one_year
+                prod10_harvest(i,0)  = prod10_harvest(i,0)  +coeff_lcchange_10(j)*relharvest*veget_max_old(i,j)
+                prod100_harvest(i,0) = prod100_harvest(i,0) +coeff_lcchange_100(j)*relharvest*veget_max_old(i,j)
+             ENDIF
+          ENDDO
+       ENDIF
+
+       cflux_prod10_harvest(i) = cflux_prod10_harvest(i) + flux10_harvest(i,1) 
+       flux10_harvest(i,1)     = 0.1 * prod10_harvest(i,0)
+       prod10_harvest(i,1)     = prod10_harvest(i,0)
+       
+       !! 3.5 update 100 year-turnover pool content following flux emission\n
+       DO   l = 0, 98
+          m = 100 - l
+          cflux_prod100_harvest(i)  =  cflux_prod100_harvest(i) + flux100_harvest(i,m)
+          prod100_harvest(i,m)      =  prod100_harvest(i,m-1)   - flux100_harvest(i,m-1)
+          flux100_harvest(i,m)      =  flux100_harvest(i,m-1)
+          IF (prod100_harvest(i,m).LT.1.0) prod100_harvest(i,m) = zero
+       ENDDO
+       
+       cflux_prod100_harvest(i)  = cflux_prod100_harvest(i) + flux100_harvest(i,1) 
+       flux100_harvest(i,1)      = 0.01 * prod100_harvest(i,0)
+       prod100_harvest(i,1)      = prod100_harvest(i,0)
+       prod10_harvest(i,0)        = 0.0
+       prod100_harvest(i,0)       = 0.0 
+       
+    ENDDO ! Loop over # pixels - domain size
+    
+  !! 4. history
+    convflux_harvest        = convflux_harvest/one_year*dt_days
+    cflux_prod10_harvest    = cflux_prod10_harvest/one_year*dt_days
+    cflux_prod100_harvest   = cflux_prod100_harvest/one_year*dt_days
+    fHarvestToProduct       = fHarvestToProduct/one_year*dt_days    
+    IF (printlev>=4) WRITE(numout,*) 'Leaving woodharvest_main'
+    
+  END SUBROUTINE woodharvest_main
+  
+END MODULE stomate_woodharvest
Index: /branches/publications/ORCHIDEE-AFP/src_xml/CMIP6_ping_land.xml
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_xml/CMIP6_ping_land.xml	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_xml/CMIP6_ping_land.xml	(revision 8430)
@@ -0,0 +1,339 @@
+<!-- ==================================================================================================================== -->
+<!-- CMIP6_ping_land.xml                                                                                                  -->
+<!-- This file is not used while running the model. It is only here for preparing output for CMIP6 simulations.           -->
+<!-- This file contains all output variables in the data request for CMIP6 concerning ORCHIDEE.                           -->
+<!-- field id should not be changed. It is used by the tool dr2xml to produce specific file_def.xml files for CMIP6.      -->
+<!-- field_ref corresponds to field id in field_def_orchidee.xml.                                                         -->
+<!-- field_ref="dummy" means that the corresponding output variable in ORCHIDEE has not yet been identified or coded.     -->
+<!--                                                                                                                      -->
+<!-- $HeadURL$              -->
+<!-- $Date$                                                               -->
+<!-- $Revision$                                                                                                    -->
+<!-- ==================================================================================================================== -->
+
+<!-- Ping files generated by dr2xml 1.16 using Data Request 01.00.28 -->
+<!-- Note that comments are not updated since ping files were generated by dr2xml 0.27 using Data Request 01.00.21 -->
+<!-- lrealms= ['land'] -->
+<!-- exact= False -->
+<!--  listof_home_vars : None
+ tierMax : 3
+ realms_per_context : {'lmdz': ['atmos', 'atmos land'], 'nemo': ['seaIce', 'ocean', 'ocean seaIce', 'ocnBgchem', 'seaIce ocean'], 'orchidee': ['land', 'landIce land', 'land landIce', 'landIce']}
+ max_priority : 3
+ max_file_size_in_floats : 20000000000.0
+ grid_choice : {'IPSL-CM6A-LR': 'LR'}
+ excluded_vars_file : None
+ sizes : {'LR': [20592, 79, 32768, 91, 30, 14, 128]}
+ ping_variables_prefix : CMIP6_
+ source_types : {'IPSL-CM6A-LR': 'AOGCM AER BGC'}
+ path_extra_tables : None
+ grid_policy : native
+ path_special_defs : None
+ mips : {'LR': set(['CDRMIP', 'CORDEX', 'GMMIP', 'RFMIP', 'VolMIP', 'CMIP6', 'ScenarioMIP', 'GeoMIP', 'C4MIP', 'PDRMIP', 'CMIP', 'DECK', 'LUMIP', 'CMIP5', 'CFMIP', 'OMIP', 'DAMIP', 'CCMI', 'SolarMIP', 'VIACSAB', 'SIMIP', 'DCPP', 'ISMIP6', 'AerChemMIP', 'PMIP', 'FAFMIP', 'DynVar', 'LS3MIP', 'SPECS', 'HighResMIP'])}
+ excluded_vars : []
+ orphan_variables : {}
+--> 
+
+<context id="land">
+<field_definition>
+<!-- for variables which realm equals one of _land-->
+   <field id="CMIP6_agesno"        field_ref="snowage_glob"         /> <!-- P1 (day) age_of_surface_snow : age_of_surface_snow -->
+   <field id="CMIP6_agesno"        field_ref="snowage_glob"         /> <!-- P1 (day) age_of_surface_snow : When computing the time-mean here, the time samples, weighted by the mass of snow on the land portion of the grid cell, are accumulated and then divided by the sum of the weights.  Reported as "missing in regions free of snow on land. -->
+   <field id="CMIP6_albc"          field_ref="vegalb_glob"         /> <!-- P1 (1) canopy_albedo : Canopy Albedo -->
+   <field id="CMIP6_albsn"         field_ref="albedo_snow"         /> <!-- P1 (1) snow_and_ice_albedo : Snow Albedo -->
+   <field id="CMIP6_areacella"     field_ref="areas"         /> <!-- P1 (m2) cell_area : Cell areas for any grid used to report atmospheric variables and any other variable using that grid (e.g., soil moisture content). These cell areas should be defined to enable exact calculation of global integrals (e.g., of vertical fluxes of energy at the surface and top of the atmosphere). -->
+   <field id="CMIP6_areacellg"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (m2) cell_area : Cell areas any grid used to report ice sheet variables. These cell areas should be defined to enable exact calculation of area integrals (e.g., of vertical fluxes of energy at the surface and top of the atmosphere) -->
+   <field id="CMIP6_areacellr"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (m2) cell_area : Cell areas for any grid used to report river model variables (may be the same as for atmospheric variables). These cell areas should be defined to enable exact calculation of area integrals (e.g., of vertical fluxes of energy at the surface and top of the atmosphere). -->
+   <field id="CMIP6_ares"          field_ref="raero"         /> <!-- P1 (s m-1) aerodynamic_resistance : aerodynamic_resistance -->
+   <field id="CMIP6_baresoilFrac"  field_ref="baresoilFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by bare soil. Warning: we do not include the bare soil fraction from the vegetated pft's. Note: Multiplied in sechiba by contfrac because we need entire grid-cell -->
+   <field id="CMIP6_burntFractionAll" field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : Percentage of grid cell burned due to all fires including natural and anthropogenic fires and those associated with anthropogenic land use change -->
+   <field id="CMIP6_c13Land"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) total_land_c13 : Mass of 13C in all terrestrial carbon pools -->
+   <field id="CMIP6_c13Litter"     field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_c13_content : Mass of 13C in Litter Pool -->
+   <field id="CMIP6_c13Soil"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) soil_c13_content : Mass of 13C in Soil Pool -->
+   <field id="CMIP6_c13Veg"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) vegetation_c13_content : Mass of 13C in Vegetation -->
+   <field id="CMIP6_c14Land"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) total_land_c14 : Mass of 14C in all terrestrial carbon pools -->
+   <field id="CMIP6_c14Litter"     field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_c14_content : Mass of 14C in Litter Pool -->
+   <field id="CMIP6_c14Soil"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) soil_c14_content : Mass of 14C in Soil Pool -->
+   <field id="CMIP6_c14Veg"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) vegetation_c14_content : only requested for DECK HIST -->
+   <field id="CMIP6_c3PftFrac"     field_ref="c3PftFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by C3 PFTs (including grass, crops, and trees). -->
+   <field id="CMIP6_c4PftFrac"     field_ref="c4PftFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by C4 PFTs (including grass and crops). -->
+   <field id="CMIP6_cCwd"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) wood_debris_carbon_content : Carbon Mass in Coarse Woody Debris -->
+   <field id="CMIP6_cLand"         field_ref="cLand"         /> <!-- P1 (kg m-2) total_land_carbon : Total Carbon in All Terrestrial Carbon Pools -->
+   <field id="CMIP6_cLeaf"         field_ref="cLeaf"         /> <!-- P1 (kg m-2) leaf_carbon_content : Carbon Mass in Leaves -->
+   <field id="CMIP6_cLitter"       field_ref="cLitter"         /> <!-- P1 (kg m-2) litter_carbon_content : Carbon Mass in Litter Pool -->
+   <field id="CMIP6_cLitterAbove"  field_ref="cLitterAbove"         /> <!-- P1 (kg m-2) surface_litter_carbon_content : Carbon Mass in Above-Ground Litter -->
+   <field id="CMIP6_cLitterBelow"  field_ref="cLitterBelow"         /> <!-- P1 (kg m-2) subsurface_litter_carbon_content : Carbon Mass in Below-Ground Litter -->
+   <field id="CMIP6_cLitterCwd"    field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_wood_debris_carbon_content : Carbon Mass in Coarse Woody Debris -->
+   <field id="CMIP6_cLitterGrass"  field_ref="cLitterGrass"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on grass tiles -->
+   <field id="CMIP6_cLitterLut"    field_ref="clitterlut" /> <!-- P1 (kg m-2) litter_carbon_content : carbon  in above and belowground litter pools on land use tiles -->
+   <field id="CMIP6_cLitterShrub"  field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on shrub tiles -->
+   <field id="CMIP6_cLitterSubSurf" field_ref="cLitterBelow"         /> <!-- P2 (kg m-2) subsurface_litter_carbon_content : Carbon Mass in Below-Ground Litter Warning: Duplicate of CMIP6_cLitterBelow -->
+   <field id="CMIP6_cLitterSurf"   field_ref="cLitterAbove"         /> <!-- P2 (kg m-2) surface_litter_carbon_content : Carbon Mass in Above-Ground Litter Warning: Duplicate of CMIP6_cLitterAbove -->
+   <field id="CMIP6_cLitterTree"   field_ref="cLitterTree"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on tree tiles -->
+   <field id="CMIP6_cMisc"         field_ref="cMisc"         /> <!-- P2 (kg m-2) miscellaneous_living_matter_carbon_content : Carbon Mass in Other Living Compartments on Land -->
+   <field id="CMIP6_cOther"        field_ref="cOther"         /> <!-- P2 (kg m-2) other_vegegtation_components_carbon_content : Carbon Mass in Vegetation Components other than Leaves, Stems and Roots -->
+   <field id="CMIP6_cProduct"      field_ref="cProduct"         /> <!-- P1 (kg m-2) carbon_content_of_products_of_anthropogenic_land_use_change : Carbon Mass in Products of Land Use Change -->
+   <field id="CMIP6_cProductLut"   field_ref="cproductlut" /> <!-- P1 (kg m-2) carbon_content_in_wood_and_agricultural_products : wood and agricultural product pool carbon associated with land use tiles; examples of products include paper, cardboard, timber for construction, and crop harvest for food or fuel. -->
+   <field id="CMIP6_cRoot"         field_ref="cRoot"         /> <!-- P1 (kg m-2) root_carbon_content : including fine and coarse roots. -->
+   <field id="CMIP6_cSoil"         field_ref="cSoil"         /> <!-- P1 (kg m-2) soil_carbon_content : Carbon Mass in Soil Pool -->
+   <field id="CMIP6_cSoilAbove1m"  field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) soil_carbon_content : Carbon mass in soil pool above 1m depth -->
+   <field id="CMIP6_cSoilFast"     field_ref="cSoilFast"         /> <!-- P1 (kg m-2) fast_soil_pool_carbon_content : fast is meant as lifetime of less than 10 years for  reference climate conditions (20 C, no water limitations). -->
+   <field id="CMIP6_cSoilGrass"    field_ref="cSoilGrass"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on grass tiles -->
+   <field id="CMIP6_cSoilLevels"   field_ref="dummy_XYSo_not_provided"       /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in each model soil level (summed over all soil carbon pools in that level) -->
+   <field id="CMIP6_cSoilLut"      field_ref="csoillut" /> <!-- P1 (kg m-2) soil_carbon_content : carbon  in soil pool on land use tiles -->
+   <field id="CMIP6_cSoilMedium"   field_ref="cSoilMedium"         /> <!-- P1 (kg m-2) medium_soil_pool_carbon_content : medium is meant as lifetime of more than than 10 years and less than 100 years for  reference climate conditions (20 C, no water limitations) -->
+   <field id="CMIP6_cSoilPools"    field_ref="cSoilPools"/> <!-- P2 (kg m-2) soil_carbon_content_by_pool : Carbon mass in each model soil pool (summed over vertical levels) -->
+   <field id="CMIP6_cSoilShrub"    field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on shrub tiles -->
+   <field id="CMIP6_cSoilSlow"     field_ref="cSoilSlow"         /> <!-- P1 (kg m-2) slow_soil_pool_carbon_content : fast is meant as lifetime of more than 100 years for  reference climate conditions (20 C, no water limitations) -->
+   <field id="CMIP6_cSoilTree"     field_ref="cSoilTree"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on tree tiles -->
+   <field id="CMIP6_cStem"         field_ref="cStem"         /> <!-- P2 (kg m-2) stem_carbon_content : Carbon Mass in Stem -->
+   <field id="CMIP6_cTotFireLut"   field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (kg m-2 s-1)  : Total carbon loss from natural and managed fire on land use tile, including deforestation fires -->
+   <field id="CMIP6_cVeg"          field_ref="cVeg"         /> <!-- P1 (kg m-2) vegetation_carbon_content : Carbon Mass in Vegetation -->
+   <field id="CMIP6_cVegGrass"     field_ref="cVegGrass"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on grass tiles -->
+   <field id="CMIP6_cVegLut"       field_ref="cveglut" /> <!-- P1 (kg m-2) vegetation_carbon_content : carbon in vegetation on land use tiles -->
+   <field id="CMIP6_cVegShrub"     field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on shrub tiles -->
+   <field id="CMIP6_cVegTree"      field_ref="cVegTree"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on tree tiles -->
+   <field id="CMIP6_cWood"         field_ref="cWood"         /> <!-- P2 (kg m-2) wood_carbon_content : Carbon Mass in Wood -->
+   <field id="CMIP6_clayfrac"      field_ref="clayfraction"       /> <!-- P1 (1) volume_fraction_of_clay_in_soil : Clay Fraction -->
+   <field id="CMIP6_cnc"           field_ref="cnc"         /> <!-- P1 (%) vegetation_area_fraction : Canopy covered fraction Warning: fraction over total land -->
+   <field id="CMIP6_cropFrac"      field_ref="cropFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by crop. Warning: Note: Multiplied in sechiba by contfrac because we need entire grid-cell -->
+   <field id="CMIP6_cropFracC3"    field_ref="cropFracC3"         /> <!-- P1 (%) area_fraction : Percentage Cover by C3 Crops -->
+   <field id="CMIP6_cropFracC4"    field_ref="cropFracC4"         /> <!-- P1 (%) area_fraction : Percentage Cover by C4 Crops -->
+   <field id="CMIP6_cw"            field_ref="qsintveg_tot"         /> <!-- P1 (kg m-2) canopy_water_amount : canopy_water_amount -->
+   <field id="CMIP6_dcw"           field_ref="delintercept"         /> <!-- P1 (kg m-2) change_over_time_in_canopy_water_amount : change_over_time_in_canopy_water_amount -->
+   <field id="CMIP6_dgw"           field_ref="delslowr"         /> <!-- P1 (kg m-2) change_over_time_in_groundwater : change_over_time_in_groundwater Warning: It can be either undef or delslowr. We take the second option for the moment. -->
+   <field id="CMIP6_dmlt"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (m) depth_of_subsurface_melting : depth_of_subsurface_melting -->
+   <field id="CMIP6_drivw"         field_ref="delriv"         /> <!-- P1 (kg m-2) change_over_time_in_river_water_amount : change_over_time_in_river_water_amount Warning: we sum the stream and fast reservoir of the routing scheme. -->
+   <field id="CMIP6_dslw"          field_ref="delsoilmoist"         /> <!-- P1 (kg m-2) change_over_time_in_water_content_of_soil_layer : change_over_time_in_water_content_of_soil_layer -->
+   <field id="CMIP6_dsn"           field_ref="delswe"         /> <!-- P1 (kg m-2) change_over_time_in_surface_snow_and_ice_amount : change_over_time_in_surface_snow_and_ice_amount -->
+   <field id="CMIP6_dsw"           field_ref="delsurfwater"         /> <!-- P1 (kg m-2) change_over_time_in_surface_water_amount : change_over_time_in_surface_water_amount Warning: includes the fast reservoire -->
+   <field id="CMIP6_dtes"          field_ref="dtes"         /> <!-- P1 (J m-2) change_over_time_in_thermal_energy_content_of_surface : Change in surface heat storage -->
+   <field id="CMIP6_dtesn"         field_ref="del_snowheattot"         /> <!-- P1 (J m-2) change_over_time_in_thermal_energy_content_of_surface_snow_and_ice : Change in snow/ice cold content Warning: Computed only for the layered scheme on vegetated and bare soil area -->
+   <field id="CMIP6_ec"            field_ref="evspsblveg"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_canopy : liquid_water_evaporation_flux_from_canopy -->
+   <field id="CMIP6_eow"           field_ref="vevapflo"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_open_water : liquid_water_evaporation_flux_from_open_water -->
+   <field id="CMIP6_es"            field_ref="vevapnu"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_soil : liquid_water_evaporation_flux_from_soil -->
+   <field id="CMIP6_esn"           field_ref="vevapsno"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_surface_snow : liquid_water_evaporation_flux_from_surface_snow -->
+   <field id="CMIP6_evspsbl"       field_ref="vevapp"         /> <!-- P1 (kg m-2 s-1) surface_evapotranspiration : surface_evapotranspiration -->
+   <field id="CMIP6_evspsblpot"    field_ref="evapot"         /> <!-- P1 (kg m-2 s-1) water_potential_evaporation_flux : Potential Evapotranspiration -->
+   <field id="CMIP6_evspsblsoi"    field_ref="evspsblsoi"         /> <!-- P1 (kg m-2 s-1) water_evaporation_flux_from_soil : includes sublimation. -->
+   <field id="CMIP6_evspsblveg"    field_ref="evspsblveg"         /> <!-- P1 (kg m-2 s-1) water_evaporation_flux_from_canopy : the canopy evaporation+sublimation (if present in model). Warning: No sublimation here for Orchidee -->
+   <field id="CMIP6_fAnthDisturb"  field_ref="fAnthDisturb"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_anthrogpogenic_emission : carbon mass flux into atmosphere due to any human activity -->
+   <field id="CMIP6_fBNF"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) biological_nitrogen_fixation : biological nitrogen fixation -->
+   <field id="CMIP6_fCLandToOcean" field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_ocean_from_rivers : Lateral transfer of carbon out of gridcell that eventually goes into ocean -->
+   <field id="CMIP6_fDeforestToAtmos" field_ref="fLuc"         /> <!-- P2 (kg m-2 s-1) surface_net_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_anthropogenic_land_use_change : Deforested biomass that goes into atmosphere as a result of anthropogenic land use change Warning : duplicate of variable fLuc -->
+   <field id="CMIP6_fDeforestToProduct" field_ref="fDeforestToProduct"         /> <!-- P1 (kg m-2 s-1) deforested_biomass_into_product_pool_due_to_anthorpogenic_land_use_change : Deforested biomass that goes into product pool as a result of anthropogenic land use change -->
+   <field id="CMIP6_fFire"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_fires_excluding_anthropogenic_land_use_change : CO2 emissions (expressed as a carbon mass flux) from natural fires + human ignition fires as calculated by the fire module of the DGVM, but excluding any CO2 flux from fire included in fLuc, defined below (CO2 Flux to Atmosphere from Land Use Change). -->
+   <field id="CMIP6_fFireAll"      field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_all_sources : Carbon Mass Flux into Atmosphere due to CO2 emissions from Fire resulting from all sources including natural, anthropogenic and land use change. -->
+   <field id="CMIP6_fFireNat"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) fire_CO2_emissions_from_wildfire : Carbon Mass Flux into Atmosphere due to CO2 Emission from natural Fire -->
+   <field id="CMIP6_fGrazing"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_grazing : Carbon Mass Flux into Atmosphere due to Grazing on Land -->
+   <field id="CMIP6_fHarvest"      field_ref="fHarvest"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_crop_harvesting : Carbon Mass Flux into Atmosphere due to Crop Harvesting -->
+   <field id="CMIP6_fHarvestToAtmos" field_ref="fHarvest"         /> <!-- P2 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_crop_harvesting : Harvested biomass that goes straight into atmosphere Warning : Duplicate variable fHarvest -->
+   <field id="CMIP6_fHarvestToProduct" field_ref="fHarvestToProduct"         /> <!-- P1 (kg m-2 s-1) harvested_biomass_into_product_pool : Harvested biomass that goes into product pool -->
+   <field id="CMIP6_fLitterFire"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_litter_carbon : Carbon Mass Flux from Litter, CWD or any non-living pool into Atmosphere due to CO2 Emission from all Fire -->
+   <field id="CMIP6_fLitterSoil"   field_ref="fLitterSoil"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_from_litter : Total Carbon Mass Flux from Litter to Soil -->
+   <field id="CMIP6_fLuc"          field_ref="fLuc"         /> <!-- P1 (kg m-2 s-1) surface_net_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_anthropogenic_land_use_change : Net Carbon Mass Flux into Atmosphere due to Land Use Change -->
+   <field id="CMIP6_fLulccAtmLut"  field_ref="flulccatmlut" /> <!-- P1 (kg s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_direct_to_atmosphere_due_to_anthropogenic_land_use_land_cover_change : carbon transferred directly to atmosphere due to any land-use or land-cover change activities including deforestation or agricultural fire -->
+   <field id="CMIP6_fLulccProductLut" field_ref="flulccproductlut" /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_wood_and_agricultural_product_pools_due_to_anthropogenic_land_use_or_land_cover_change : carbon harvested due to land-use or land-cover change process that enters anthropogenic product pools on tile -->
+   <field id="CMIP6_fLulccResidueLut" field_ref="flulccresiduelut" /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_and_litter_due_to_anthropogenic_land_use_or_land_cover_change : carbon transferred to soil or litter pools due to land-use or land-cover change processes on tile -->
+   <field id="CMIP6_fN2O"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) land_net_n2o_flux : Total land N2O flux -->
+   <field id="CMIP6_fNAnthDisturb" field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_flux_into_atmos_due_to_direct_human_disturbance : nitrogen mass flux out of land due to any human activity -->
+   <field id="CMIP6_fNLandToOcean" field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_ocean_from_rivers : Lateral transfer of nitrogen out of gridcell that eventually goes into ocean -->
+   <field id="CMIP6_fNLitterSoil"  field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_soil_from_litter : Total Nitrogen Mass Flux from Litter to Soil -->
+   <field id="CMIP6_fNOx"          field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) land_net_nox_flux : Total land NOx flux -->
+   <field id="CMIP6_fNProduct"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_to_product_pool_due_to_anthorpogenic_activity : Deforested or harvested biomass as a result of anthropogenic land use or change -->
+   <field id="CMIP6_fNVegLitter"   field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) litter_nitrogen_flux : Total Nitrogen Mass Flux from Vegetation to Litter -->
+   <field id="CMIP6_fNVegSoil"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_soil_from_vegetation_excluding_litter : Total Nitrogen Mass Flux from Vegetation Directly to Soil -->
+   <field id="CMIP6_fNdep"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) deposition_of_nitrogen_onto_land : Dry and Wet Deposition of Reactive Nitrogen onto Land -->
+   <field id="CMIP6_fNfert"        field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) fertiliser_of_nitrogen_onto_land : total N added for cropland fertilisation (artificial and manure) -->
+   <field id="CMIP6_fNgas"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere : Total Nitrogen lost to the atmosphere (sum of NHx, NOx, N2O, N2) -->
+   <field id="CMIP6_fNgasFire"     field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere_due_to_fire : Total N lost to the atmosphere (including NHx, NOx, N2O, N2) from fire. -->
+   <field id="CMIP6_fNgasNonFire"  field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere_not_due_to_fire : Total N lost to the atmosphere (including NHx, NOx, N2O, N2) from all processes except fire. -->
+   <field id="CMIP6_fNleach"       field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost_to_leaching : Total N loss to leaching or runoff (sum of ammonium, nitrite and nitrate) -->
+   <field id="CMIP6_fNloss"        field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost : Total N lost (including NHx, NOx, N2O, N2 and leaching) -->
+   <field id="CMIP6_fNnetmin"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) net_nitrogen_mineralisation : Net nitrogen release from soil and litter as the outcome of nitrogen immobilisation and gross mineralisation -->
+   <field id="CMIP6_fNup"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) plant_nitrogen_uptake : total plant nitrogen uptake (sum of ammonium and nitrate), irrespective of the source of nitrogen -->
+   <field id="CMIP6_fProductDecomp" field_ref="fProductDecomp"         /> <!-- P1 (kg m-2 s-1) Carbon_flux_out_of_storage_product_pools_into_atmos : decomposition out of product pools to CO2 in atmos Warning Duplicated variable with fDeforestToProduct -->
+   <field id="CMIP6_fProductDecompLut" field_ref="flulccatmlut" /> <!-- P1 (kg s-1) tendency_of_atmospheric_mass_content_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_wood_and_agricultural_product_pool : flux from wood and agricultural product pools on land use tile into atmosphere -->
+   <field id="CMIP6_fVegFire"      field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_vegetation_carbon : Carbon Mass Flux from Vegetation into Atmosphere due to CO2 Emission from all Fire -->
+   <field id="CMIP6_fVegLitter"    field_ref="fVegLitter"         /> <!-- P1 (kg m-2 s-1) litter_carbon_flux : Total Carbon Mass Flux from Vegetation to Litter -->
+   <field id="CMIP6_fVegLitterMortality" field_ref="dummy_XY_not_provided"   /> <!-- P2 (kg m-2 s-1) mortality_litter_carbon_flux : Total Carbon Mass Flux from Vegetation to Litter as a Result of Mortality -->
+   <field id="CMIP6_fVegLitterSenescence" field_ref="dummy_XY_not_provided"  /> <!-- P2 (kg m-2 s-1) senescence_litter_carbon_flux : Total Carbon Mass Flux from Vegetation to Litter as a Result of Leaf, Branch, and Root Senescence -->
+   <field id="CMIP6_fVegSoil"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_from_vegetation_excluding_litter : In some models part of carbon (e.g., root exudate) can go directly into the soil pool without entering litter. -->
+   <field id="CMIP6_fVegSoilMortality" field_ref="dummy_XY_not_provided"     /> <!-- P2 (kg m-2 s-1) mortality_vegtosoil_carbon_flux : Total Carbon Mass Flux from Vegetation to Soil as a result of mortality -->
+   <field id="CMIP6_fVegSoilSenescence" field_ref="dummy_XY_not_provided"    /> <!-- P2 (kg m-2 s-1) senescence_vegtosoil_carbon_flux : Total Carbon Mass Flux from Vegetation to Soil as a result of leaf, branch, and root senescence -->
+   <field id="CMIP6_fahLut"        field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upward_heat_flux_due_to_anthropogenic_energy_consumption : Anthropogenic heat flux generated from non-renewable human primary energy consumption, including energy use by vehicles, commercial and residential buildings, industry, and power plants.  Primary energy refers to energy in natural resources, fossil and nonfossil, before conversion into other forms, such as electricity. -->
+   <field id="CMIP6_fldcapacity"   field_ref="fldcapacity"       /> <!-- P1 (%) volume_fraction_of_condensed_water_in_soil_at_field_capacity : Field Capacity -->
+   <field id="CMIP6_fracInLut"     field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (%) area_fraction : annual gross fraction that was transferred into this tile from other land use tiles -->
+   <field id="CMIP6_fracLut"       field_ref="fraclut" /> <!-- P1 (%) area_fraction : fraction of grid cell for each land use tile -->
+   <field id="CMIP6_fracOutLut"    field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (%) area_fraction : annual gross fraction of land use tile  that was transferred into other land use tiles -->
+   <field id="CMIP6_gpp"           field_ref="gpp_ipcc2"         /> <!-- P1 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : only requested for DECK HIST, 1980-present -->
+   <field id="CMIP6_gppGrass"      field_ref="gppgrass"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary production on grass tiles -->
+   <field id="CMIP6_gppLut"        field_ref="gpplut" /> <!-- P1 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary productivity on land use tile -->
+   <field id="CMIP6_gppShrub"      field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary production on Shrub tiles -->
+   <field id="CMIP6_gppTree"       field_ref="gpptree"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary production on tree tiles -->
+   <field id="CMIP6_gppc13"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_c13 : Mass Flux of 13C out of Atmosphere due to Gross Primary Production on Land -->
+   <field id="CMIP6_gppc14"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_c14 : Mass Flux of 14C out of Atmosphere due to Gross Primary Production on Land -->
+   <field id="CMIP6_grassFrac"     field_ref="grassFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell that is covered by natural grass. -->
+   <field id="CMIP6_grassFracC3"   field_ref="grassFracC3"         /> <!-- P1 (%) area_fraction : C3 grass Area Percentage -->
+   <field id="CMIP6_grassFracC4"   field_ref="grassFracC4"         /> <!-- P1 (%) area_fraction : C4 grass Area Percentage -->
+   <field id="CMIP6_hfdsn"         field_ref="snowflxtot"         /> <!-- P1 (W m-2) surface_downward_heat_flux_in_snow : the net downward heat flux from the atmosphere into the snow that lies on land divided by the land area in the grid cell; reported as missing for snow-free land regions or where the land fraction is 0. -->
+   <field id="CMIP6_hfls"          field_ref="fluxlat"           /> <!-- P1 (W m-2) surface_upward_latent_heat_flux : The surface called "surface" means the lower boundary of the atmosphere. "Upward" indicates a vector component which is positive when directed upward (negative downward). The surface latent heat flux is the exchange of heat between the surface and the air on account of evaporation (including sublimation). In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. -->
+   <field id="CMIP6_hflsLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upward_latent_heat_flux : latent heat flux on land use tile -->
+   <field id="CMIP6_hfss"          field_ref="fluxsens"          /> <!-- P1 (W m-2) surface_upward_sensible_heat_flux : The surface called "surface" means the lower boundary of the atmosphere. "Upward" indicates a vector component which is positive when directed upward (negative downward). The surface sensible heat flux, also called "turbulent" heat flux, is the exchange of heat between the surface and the air by motion of air. In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. Unless indicated in the cell_methods attribute, a quantity is assumed to apply to the whole area of each horizontal grid box. Previously, the qualifier where_type was used to specify that the quantity applies only to the part of the grid box of the named type.  Names containing the where_type qualifier are deprecated and newly created data should use the cell_methods attribute to indicate the horizontal area to which the quantity applies. -->
+   <field id="CMIP6_hfssLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upward_sensible_heat_flux : sensible heat flux on land use tile -->
+   <field id="CMIP6_hussLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (1) specific_humidity : near-surface specific humidity on land use tile -->
+   <field id="CMIP6_irrLut"        field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (kg s-1) surface_downward_water_flux_due_to_irrigation : Irrigation flux including any irrigation for crops, trees, pasture, or urban lawns -->
+   <field id="CMIP6_ksat"          field_ref="ksat"       /> <!-- P1 (1e-6 m s-1)  : Saturated Hydraulic Conductivity -->
+   <field id="CMIP6_lai"           field_ref="lai_ipcc"         /> <!-- P1 (1) leaf_area_index : a ratio obtained by dividing the total upper leaf surface area of vegetation by the (horizontal) surface area of the land on which it grows. Warning: here we take the average over the entire land fraction; not sure it's ok with the DataRequest comment "a ratio obtained by dividing the total upper leaf surface area of vegetation by the (horizontal) surface area of the land on which it grows." PC+JG : lai_ipcc and laimean are related to the same land fraction(note veget_max in stomate_lpj is not the same veget_max in sechiba!). We see other differencies between these output variables coming mainly from pft3 and some from 6,8,9,12. -->
+   <field id="CMIP6_laiLut"        field_ref="lailut" /> <!-- P1 (1)  : Leaf Area Index on Land Use Tile -->
+   <field id="CMIP6_landCoverFrac" field_ref="landCoverFrac" /> <!-- P1 (%) area_fraction : The categories may differ from model to model, depending on their  PFT definitions.   This may include natural PFTs, anthropogenic PFTs, bare soil, lakes, urban areas, etc.   Sum of all should equal the fraction of the grid-cell that is land. Warning: Note: here not multiplying by contfrac according to DR -->
+   <field id="CMIP6_lwsnl"         field_ref="snowliqtot"         /> <!-- P1 (kg m-2) liquid_water_content_of_snow_layer : where land over land: this is computed as the total mass of liquid water contained interstitially within the snow layer of the land portion of a grid cell divided by the area of the land portion of the cell. Warning: Computed only for the layered scheme on vegetated and bare soil area. -->
+   <field id="CMIP6_mrfso"         field_ref="humtot_frozen"         /> <!-- P1 (kg m-2) soil_frozen_water_content : the mass (summed over all all layers) of frozen water. Warning: To be calculated. -->
+   <field id="CMIP6_mrfsofr"       field_ref="profil_froz_hydro"       /> <!-- P1 (1) mass_fraction_of_frozen_water_in_soil_moisture : mass_fraction_of_frozen_water_in_soil_layer -->
+   <field id="CMIP6_mrlqso"        field_ref="profil_liquid_hydro"       /> <!-- P1 (1) mass_fraction_of_unfrozen_water_in_soil_moisture : mass_fraction_of_unfrozen_water_in_soil_layer -->
+   <field id="CMIP6_mrlso"         field_ref="humtot_liquid"         /> <!-- P1 (kg m-2) soil_liquid_water_content : Soil Liquid Water Content -->
+   <field id="CMIP6_mrro"          field_ref="mrro"         /> <!-- P1 (kg m-2 s-1) runoff_flux : the total runoff (including "drainage" through the base of the soil model) leaving the land portion of the grid cell divided by the land area in the grid cell, averaged over the 3-hour interval. -->
+   <field id="CMIP6_mrroLi"        field_ref="dummy_XY_not_provided"  /> <!-- P1 (kg m-2 s-1) land_ice_runoff_flux : Runoff flux over land ice is the difference between any available liquid water in the snowpack less any refreezing. Computed as the sum of rainfall and melt of snow or ice less any refreezing or water retained in the snowpack -->
+   <field id="CMIP6_mrroLut"       field_ref="mrro_lut" /> <!-- P1 (kg m-2 s-1) runoff_flux : Total runoff from land use tile -->
+   <field id="CMIP6_mrrob"         field_ref="drainage"         /> <!-- P1 (kg m-2 s-1) subsurface_runoff_flux : subsurface_runoff_flux -->
+   <field id="CMIP6_mrros"         field_ref="runoff"         /> <!-- P1 (kg m-2 s-1) surface_runoff_flux : surface_runoff_flux -->
+   <field id="CMIP6_mrsfl"         field_ref="soilmoist_frozen"       /> <!-- P1 (kg m-2) frozen_moisture_content_of_soil_layer : Frozen water content of soil layer -->
+   <field id="CMIP6_mrsll"         field_ref="soilmoist_liquid"       /> <!-- P1 (kg m-2) liquid_moisture_content_of_soil_layer : Liquid water content of soil layer -->
+   <field id="CMIP6_mrso"          field_ref="humtot"         /> <!-- P1 (kg m-2) soil_moisture_content : the mass per unit area  (summed over all soil layers) of water in all phases. -->
+   <field id="CMIP6_mrsoLut"       field_ref="humtot_lut" /> <!-- P1 (kg m-2) soil_moisture_content : Total soil moisture -->
+   <field id="CMIP6_mrsofc"        field_ref="tmcfc"         /> <!-- P1 (kg m-2) soil_moisture_content_at_field_capacity : reported "where land": divide the total water holding capacity of all the soil in the grid cell by the land area in the grid cell;  reported as "missing" where the land fraction is 0. -->
+   <field id="CMIP6_mrsol"         field_ref="soilmoist"       /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : Total water content of soil layer -->
+   <field id="CMIP6_mrsos"         field_ref="humtot_top"         /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : the mass of water in all phases in a thin surface soil layer. -->
+   <field id="CMIP6_mrsosLut"      field_ref="humtot_top_lut" /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : Moisture in Upper Portion of Soil Column of land use tile -->
+   <field id="CMIP6_mrsow"         field_ref="dummy_not_provided"         /> <!-- P1 (1) volume_fraction_of_condensed_water_in_soil_at_field_capacity : relative_soil_moisture_content_above_field_capacity Warning: weird mention to field capacity in the description, overlooked. AD: 3 differents definintions, we do not know what to do -->
+   <field id="CMIP6_mrtws"         field_ref="tws"         /> <!-- P1 (kg m-2) total_water_storage : canopy_and_surface_and_subsurface_water_amount -->
+   <field id="CMIP6_nLand"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) total_land_nitrogen : Total nitrogen in all terrestrial nitrogen pools -->
+   <field id="CMIP6_nLeaf"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) leaf_nitrogen_content : Nitrogen Mass in Leaves -->
+   <field id="CMIP6_nLitter"       field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) litter_nitrogen_content : Nitrogen Mass in Litter Pool -->
+   <field id="CMIP6_nLitterCwd"    field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_wood_debris_nitrogen_content : Nitrogen Mass in Coarse Woody Debris -->
+   <field id="CMIP6_nLitterSubSurf" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) subsurface_litter_nitrogen_content : Nitrogen Mass in below ground litter (non CWD) -->
+   <field id="CMIP6_nLitterSurf"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) surface_litter_nitrogen_content : Nitrogen Mass in above ground litter (non CWD) -->
+   <field id="CMIP6_nMineral"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) mineral_soil_nitrogen_content : Mineral nitrogen in the soil -->
+   <field id="CMIP6_nMineralNH4"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) mineral_nh4_soil_nitrogen_content : Mineral ammonium in the soil -->
+   <field id="CMIP6_nMineralNO3"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) mineral_no3_soil_nitrogen_content : Mineral nitrate in the soil -->
+   <field id="CMIP6_nOther"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) other_vegegtation_components_nitrogen_content : Nitrogen mass in vegetation components other than leaves, stem and root -->
+   <field id="CMIP6_nProduct"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) nitrogen_content_of_products_of_anthropogenic_land_use_change : Nitrogen Mass in Products of Land Use Change -->
+   <field id="CMIP6_nRoot"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) root_nitrogen_content : Nitrogen Mass in Roots -->
+   <field id="CMIP6_nSoil"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) soil_nitrogen_content : Nitrogen Mass in Soil Pool -->
+   <field id="CMIP6_nStem"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) stem_nitrogen_content : Nitrogen Mass in Stem -->
+   <field id="CMIP6_nVeg"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) vegetation_nitrogen_content : Nitrogen Mass in Vegetation -->
+   <field id="CMIP6_nbp"           field_ref="nbp"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : This is the net mass flux of carbon between land and atmosphere calculated as photosynthesis MINUS the sum of  plant and soil respiration, carbonfluxes  from fire, harvest, grazing  and land use change. Positive flux  is into the land. -->
+   <field id="CMIP6_necbLut"       field_ref="necbLut" /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : net rate of C accumulation (or loss) on land use tile -->
+   <field id="CMIP6_nep"           field_ref="nep"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes_excluding_anthropogenic_land_use_change : Net Ecosystem Exchange -->
+   <field id="CMIP6_netAtmosLandC13Flux" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) net_atmos_to_land_C13_flux : Net Mass Flux of 13C between atmosphere and land (positive into land) as a result of all processes. -->
+   <field id="CMIP6_netAtmosLandC14Flux" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) net_atmos_to_land_C14_flux : Net Mass Flux of 14C between atmosphere and land (positive into land) as a result of all processes. -->
+   <field id="CMIP6_netAtmosLandCO2Flux" field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : Net flux of CO2 between atmosphere and land (positive into land) as a result of all processes. Warning: Could be done in Orchidee but not considered as a priority  -->
+   <field id="CMIP6_npp"           field_ref="npp_ipcc"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : Carbon Mass Flux out of Atmosphere due to Net Primary Production on Land -->
+   <field id="CMIP6_nppGrass"      field_ref="nppGrass"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary production on grass tiles -->
+   <field id="CMIP6_nppLeaf"       field_ref="nppLeaf"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_leaves : This is the rate of carbon uptake by leaves due to NPP -->
+   <field id="CMIP6_nppLut"        field_ref="npplut" /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary productivity on land use tile -->
+   <field id="CMIP6_nppOther"      field_ref="nppOther"         /> <!-- P2 (kg m-2 s-1) net_primary_production_allocated_to_other : net primary production allcoated to other pools (not leaves stem or roots) -->
+   <field id="CMIP6_nppRoot"       field_ref="nppRoot"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_roots : This is the rate of carbon uptake by roots due to NPP -->
+   <field id="CMIP6_nppShrub"      field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary production on Shrub tiles -->
+   <field id="CMIP6_nppStem"       field_ref="nppStem"         /> <!-- P2 (kg m-2 s-1) net_primary_production_allocated_to_stem : net primary production allcoated to stem -->
+   <field id="CMIP6_nppTree"       field_ref="nppTree"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary production on tree tiles -->
+   <field id="CMIP6_nppWood"       field_ref="nppWood"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_wood : This is the rate of carbon uptake by wood due to NPP -->
+   <field id="CMIP6_nudgincsm"     field_ref="nudgincsm"         /> <!-- P1 (kg m-2) nudging_increment_in_water_content_of_soil_layer : nudging_increment_in_water_content_of_soil_layer -->
+   <field id="CMIP6_nudgincswe"    field_ref="nudgincswe"         /> <!-- P1 (kg m-2) nudging_increment_in_surface_snow_and_ice_amount : nudging_increment_in_surface_snow_and_ice_amount -->
+   <field id="CMIP6_nwdFracLut"    field_ref="nwdFraclut" /> <!-- P1 (%)  : fraction of land use tile tile that is non-woody vegetation ( e.g. herbaceous crops) -->
+   <field id="CMIP6_orog"          field_ref="dummy_XY"         /> <!-- P1 (m) surface_altitude : Surface Altitude -->
+   <field id="CMIP6_orog_ist"      field_ref="dummy_XY"         /> <!-- P1 (m) surface_altitude : This is needed in case the ice sheet elevation changes in time -->
+   <field id="CMIP6_pastureFrac"   field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by anthropogenic pasture. -->
+   <field id="CMIP6_pastureFracC3" field_ref="dummy_XY_not_provided"         /> <!-- P2 (%) area_fraction : C3 Pasture Area Percentage -->
+   <field id="CMIP6_pastureFracC4" field_ref="dummy_XY_not_provided"         /> <!-- P2 (%) area_fraction : C4 Pasture Area Percentage -->
+   <field id="CMIP6_pflw"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) liquid_water_content_of_permafrost_layer : "where land over land", i.e., this is the total mass of liquid water contained within the permafrost layer within the land portion of a grid cell divided by the area of the land portion of the cell. -->
+   <field id="CMIP6_prra"          field_ref="precip_rain"      /> <!-- P1 (kg m-2 s-1) rainfall_flux : over Land Ice//quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_prsn"          field_ref="precip_snow"      /> <!-- P1 (kg m-2 s-1) snowfall_flux : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_prveg"         field_ref="prveg"         /> <!-- P1 (kg m-2 s-1) precipitation_flux_onto_canopy : the precipitation flux that is intercepted by the vegetation canopy (if present in model) before reaching the ground. -->
+   <field id="CMIP6_qgwr"          field_ref="drainage"         /> <!-- P1 (kg m-2 s-1) water_flux_from_soil_layer_to_groundwater : water_flux_from_soil_layer_to_groundwater Warning: It can be either undef or drainage. We take the second option for the moment. -->
+   <field id="CMIP6_rGrowth"       field_ref="rGrowth_ipcc"         /> <!-- P1 (kg m-2 s-1) surface_upward_carbon_mass_flux_due_to_plant_respiration_for_biomass_growth : Carbon Mass Flux into Atmosphere due to Growth Autotrophic Respiration on Land Warning: Variable coming from stomate, can only be provided for daily or monthly output with Orchidee. -->
+   <field id="CMIP6_rMaint"        field_ref="rMaint_ipcc"         /> <!-- P1 (kg m-2 s-1) surface_upward_carbon_mass_flux_due_to_plant_respiration_for_biomass_maintenance : Carbon Mass Flux into Atmosphere due to Maintenance Autotrophic Respiration on Land Warning: Variable coming from stomate, can only be provided for daily or monthly output with Orchidee. -->
+   <field id="CMIP6_ra"            field_ref="ra"         /> <!-- P1 (kg m-2 s-1) plant_respiration_carbon_flux : only requested for DECK HIST, 1980-present Warning: Variable coming from stomate, can only be provided for daily or monthly output with Orchidee. -->
+   <field id="CMIP6_raGrass"       field_ref="raGrass"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : autotrophic respiration on grass tiles -->
+   <field id="CMIP6_raLeaf"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_leaves : Total respiration from leaves -->
+   <field id="CMIP6_raLut"         field_ref="ralut" /> <!-- P1 (kg m-2 s-1) plant_respiration_carbon_flux : plant respiration on land use tile -->
+   <field id="CMIP6_raOther"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration : Total respiration from other pools (not leaves stem or roots) -->
+   <field id="CMIP6_raRoot"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_roots : Total Respiration from Roots -->
+   <field id="CMIP6_raShrub"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : autotrophic respiration on Shrub tiles -->
+   <field id="CMIP6_raStem"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_stem : Total Respiration from Stem -->
+   <field id="CMIP6_raTree"        field_ref="raTree"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : autotrophic respiration on tree tiles -->
+   <field id="CMIP6_rac13"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) plant_respiration_c13_flux : Mass Flux of 13C into Atmosphere due to Autotrophic (Plant) Respiration on Land -->
+   <field id="CMIP6_rac14"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) plant_respiration_c14_flux : Mass Flux of 14C into Atmosphere due to Autotrophic (Plant) Respiration on Land -->
+   <field id="CMIP6_residualFrac"  field_ref="residualFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is land and is covered by "non-vegetation" and "non-bare-soil" (e.g., urban, ice, lakes, etc.) -->
+   <field id="CMIP6_rh"            field_ref="rh_ipcc2"         /> <!-- P1 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : Carbon Mass Flux into Atmosphere due to Heterotrophic Respiration on Land Warning:  Issue with duplicated variables resp_hetero from sechiba and stomate but they are calculated differently. We here need the sechiba variable for 3h freq output. -->
+   <field id="CMIP6_rhGrass"       field_ref="rhGrass"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : heterotrophic respiration on grass tiles -->
+   <field id="CMIP6_rhLitter"      field_ref="rhLitter"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux_from_litter : Carbon Mass Flux into Atmosphere due to Heterotrophic Respiration from Litter on Land -->
+   <field id="CMIP6_rhLut"         field_ref="rhlut" /> <!-- P1 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : soil heterotrophic respiration on land use tile -->
+   <field id="CMIP6_rhShrub"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : heterotrophic respiration on Shrub tiles -->
+   <field id="CMIP6_rhSoil"        field_ref="rhSoil"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux_from_soil : Carbon Mass Flux into Atmosphere due to Heterotrophic Respiration from Soil on Land -->
+   <field id="CMIP6_rhTree"        field_ref="rhTree"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : heterotrophic respiration on tree tiles -->
+   <field id="CMIP6_rhc13"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_c13_flux : Mass Flux of 13C into Atmosphere due to Heterotrophic Respiration on Land -->
+   <field id="CMIP6_rhc14"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_c14_flux : Mass Flux of 14C into Atmosphere due to Heterotrophic Respiration on Land -->
+   <field id="CMIP6_rivi"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (m3 s-1) water_flux_from_upstream : water_flux_to_downstream -->
+   <field id="CMIP6_rivo"          field_ref="hydrographs"         /> <!-- P1 (m3 s-1) water_flux_to_downstream : water_flux_from_upstream -->
+   <field id="CMIP6_rlds"          field_ref="lwdown"           /> <!-- P1 (W m-2) surface_downwelling_longwave_flux_in_air : The surface called "surface" means the lower boundary of the atmosphere. "longwave" means longwave radiation. Downwelling radiation is radiation from above. It does not mean "net downward". When thought of as being incident on a surface, a radiative flux is sometimes called "irradiance". In addition, it is identical with the quantity measured by a cosine-collector light-meter and sometimes called "vector irradiance". In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. -->
+   <field id="CMIP6_rlus"          field_ref="lwdown"    >   lwdown - lwnet </field> <!-- P1 (W m-2) surface_upwelling_longwave_flux_in_air : The surface called "surface" means the lower boundary of the atmosphere. "longwave" means longwave radiation. Upwelling radiation is radiation from below. It does not mean "net upward". When thought of as being incident on a surface, a radiative flux is sometimes called "irradiance". In addition, it is identical with the quantity measured by a cosine-collector light-meter and sometimes called "vector irradiance". In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. -->
+   <field id="CMIP6_rlusLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upwelling_longwave_flux_in_air : Surface Upwelling Longwave on Land Use Tile -->
+   <field id="CMIP6_rootd"         field_ref="zmaxh"         /> <!-- P1 (m) root_depth : report the maximum soil depth reachable by plant roots (if defined in model), i.e., the maximum soil depth from which they can extract moisture; report as "missing" where the land fraction is 0. -->
+   <field id="CMIP6_rootdsl"       field_ref="dummy_XYSo"       /> <!-- P1 (kg m-2) root_mass_content_of_carbon : Root Distribution -->
+   <field id="CMIP6_rsds"          field_ref="swdown"         /> <!-- P1 (W m-2) surface_downwelling_shortwave_flux_in_air : surface solar irradiance for UV calculations -->
+   <field id="CMIP6_rsus"          field_ref="swdown"   >   swdown - swnet </field> <!-- P1 (W m-2) surface_upwelling_shortwave_flux_in_air : The surface called "surface" means the lower boundary of the atmosphere. "shortwave" means shortwave radiation. Upwelling radiation is radiation from below. It does not mean "net upward". When thought of as being incident on a surface, a radiative flux is sometimes called "irradiance". In addition, it is identical with the quantity measured by a cosine-collector light-meter and sometimes called "vector irradiance". In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. -->
+   <field id="CMIP6_rsusLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upwelling_shortwave_flux_in_air : Surface Upwelling Shortwave  on Land Use Tile -->
+   <field id="CMIP6_rzwc"          field_ref="humtot"         /> <!-- P1 (kg m-2) water_content_of_root_zone : water_content_of_root_zone -->
+   <field id="CMIP6_sandfrac"      field_ref="sandfraction"       /> <!-- P1 (1)  : Sand Fraction -->
+   <field id="CMIP6_sftgif"        field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) land_ice_area_fraction : Fraction of Grid Cell Covered with Glacier -->
+   <field id="CMIP6_shrubFrac"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by shrub. -->
+   <field id="CMIP6_slthick"       field_ref="dlh"       /> <!-- P1 (m)  : Thickness of Soil Layers -->
+   <field id="CMIP6_snc"           field_ref="frac_snow"         /> <!-- P1 (%) surface_snow_area_fraction : Fraction of each grid cell that is occupied by snow that rests on land portion of cell. -->
+   <field id="CMIP6_snc_ist"       field_ref="dummy_ist"         /> <!-- P1 (%) surface_snow_area_fraction : quantity averaged over ice sheet  only, to avoid contamination from other surfaces (eg: permafrost) -->
+   <field id="CMIP6_snd"           field_ref="snowdepth"         /> <!-- P1 (m) surface_snow_thickness : where land over land, this is computed as the mean thickness of snow in the land portion of the grid cell (averaging over the entire land portion, including the snow-free fraction).  Reported as missing where the land fraction is 0. Warning: Computed and weigthed only for the layered scheme on vegetated and bare soil area. -->
+   <field id="CMIP6_snm_land"      field_ref="snowmelt"         /> <!-- P1 (kg m-2 s-1) surface_snow_melt_flux : Computed as the total surface melt water on the land portion of the grid cell divided by the land area in the grid cell; report as 0.0 for snow-free land regions; report as missing where the land fraction is 0. -->
+   <field id="CMIP6_snm_land"      field_ref="snowmelt"         /> <!-- P1 (kg m-2 s-1) surface_snow_melt_flux : surface_snow_and_ice_melt_flux -->
+   <field id="CMIP6_snm_ist"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_snow_melt_flux : Surface Snow Melt -->
+   <field id="CMIP6_snw"           field_ref="snow"         /> <!-- P1 (kg m-2) surface_snow_amount : Computed as the mass of surface snow on the land portion of the grid cell divided by the land area in the grid cell; reported as missing where the land fraction is 0; excluded is snow on vegetation canopy or on sea ice. -->
+   <field id="CMIP6_sootsn"        field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) soot_content_of_surface_snow : the entire land portion of the grid cell is considered, with snow soot content set to 0.0 in regions free of snow. -->
+   <field id="CMIP6_sw"            field_ref="surfwater"         /> <!-- P1 (kg m-2) surface_water_amount_assuming_no_snow : surface_water_amount_assuming_no_snow Warning: includes the fast reservoire -->
+   <field id="CMIP6_sweLut"        field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (m)  : snow water equivalent on land use tile -->
+   <field id="CMIP6_tSoilPools"    field_ref="tSoilPools"/> <!-- P2 (s-1) soil_carbon_turnover_rate_by_pool : turnover rate of each model soil carbon pool -->
+   <field id="CMIP6_tas"           field_ref="dummy_XY"         /> <!-- P1 (K) air_temperature : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_tasLut"        field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (K) air_temperature : near-surface air temperature (2m above displacement height, i.e. t_ref) on land use tile -->
+   <field id="CMIP6_tcs"           field_ref="dummy_XY_not_provided"         /> <!-- P1 (K) canopy_temperature : Vegetation Canopy Temperature -->
+   <field id="CMIP6_tgs"           field_ref="dummy_XY_not_provided"         /> <!-- P1 (K) surface_temperature : Temperature of bare soil -->
+   <field id="CMIP6_tpf"           field_ref="dummy_XY_not_provided"         /> <!-- P1 (m) permafrost_layer_thickness : where land over land: This is the mean thickness of the permafrost layer in the land portion of the grid cell.  Reported as missing in permafrost-free regions. Warning: not yet computed but maybe doable following MICT -->
+   <field id="CMIP6_tran"          field_ref="tran"         /> <!-- P1 (kg m-2 s-1) transpiration_flux : Transpiration -->
+   <field id="CMIP6_treeFrac"      field_ref="treeFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by trees. -->
+   <field id="CMIP6_treeFracBdlDcd" field_ref="treeFracBdlDcd"         /> <!-- P1 (%) area_fraction : Broadleaf deciduous tree fraction -->
+   <field id="CMIP6_treeFracBdlEvg" field_ref="treeFracBdlEvg"         /> <!-- P1 (%) area_fraction : Broadleaf evergreen tree fraction -->
+   <field id="CMIP6_treeFracNdlDcd" field_ref="treeFracNdlDcd"         /> <!-- P1 (%) area_fraction : Needleleaf deciduous tree fraction -->
+   <field id="CMIP6_treeFracNdlEvg" field_ref="treeFracNdlEvg"         /> <!-- P1 (%) area_fraction : Needleleaf evergreen tree fraction -->
+   <field id="CMIP6_treeFracPrimDec" field_ref="treeFracPrimDec"         /> <!-- P1 (%) area_fraction : This is the fraction of the entire grid cell  that is covered by "total primary deciduous trees." -->
+   <field id="CMIP6_treeFracPrimEver" field_ref="treeFracPrimEver"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by primary evergreen trees. -->
+   <field id="CMIP6_treeFracSecDec" field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by secondary deciduous trees. -->
+   <field id="CMIP6_treeFracSecEver" field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by secondary evergreen trees. -->
+   <field id="CMIP6_ts"            field_ref="dummy_XY"         /> <!-- P1 (K) surface_temperature : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_tsl"           field_ref="ptn"       /> <!-- P1 (K) soil_temperature : Temperature of single near-surface soil layer.  Reported as "missing" for grid cells occupied entirely by "sea". -->
+   <field id="CMIP6_tslsi"         field_ref="temp_sol_new"         /> <!-- P1 (K) surface_temperature : Surface temperature of all surfaces except open ocean. -->
+   <field id="CMIP6_tslsiLut"      field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (K) surface_temperature : Surface Temperature on Landuse Tile -->
+   <field id="CMIP6_tsn_land"      field_ref="dummy_XY"         /> <!-- P1 (K) temperature_in_surface_snow : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_tsn_ist"       field_ref="dummy_XY"         /> <!-- P1 (K) temperature_in_surface_snow : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_tsn_land"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (K) temperature_in_surface_snow : This temperature is averaged over all the snow in the grid cell that rests on land or land ice.  When computing the time-mean here, the time samples, weighted by the mass of snow on the land portion of the grid cell, are accumulated and then divided by the sum of the weights.   Reported as "missing in regions free of snow on land. Warning: Doable but painful with the two different snow schemes. -->
+   <field id="CMIP6_vegFrac"       field_ref="vegFrac"         /> <!-- P1 (%) area_fraction : Total vegetated fraction -->
+   <field id="CMIP6_vegHeight_land" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over all vegetation types and over the vegetated fraction of a grid cell. -->
+   <field id="CMIP6_vegHeight_veg" field_ref="dummy_XY_not_provided"         /> <!-- P1 (m) canopy_height : Vegetation height averaged over all vegetation types and over the vegetated fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightCrop" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the crop fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightGrass" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the grass fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightPasture" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the pasture fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightShrub" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the shrub fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightTree" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the tree fraction of a grid cell. -->
+   <field id="CMIP6_wetlandCH4"    field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) wetland_methane_emissions : Grid averaged methane emissions from wetlands -->
+   <field id="CMIP6_wetlandCH4cons" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) wetland_methane_consumption : Grid averaged methane consuption (methanotrophy) from wetlands -->
+   <field id="CMIP6_wetlandCH4prod" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) wetland_methane_production : Grid averaged methane production (methanogenesis) from wetlands -->
+   <field id="CMIP6_wetlandFrac"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (%) wetland_fraction : Fraction of a grid cell covered by wetland. -->
+   <field id="CMIP6_wilt"          field_ref="wilt"       /> <!-- P1 (%) volume_fraction_of_condensed_water_in_soil_at_wilting_point : Wilting Point -->
+   <field id="CMIP6_wtd"           field_ref="dummy_XY_not_provided"         /> <!-- P1 (m) depth_of_soil_moisture_saturation : depth_of_soil_moisture_saturation -->
+</field_definition>
+</context>
Index: /branches/publications/ORCHIDEE-AFP/src_xml/CMIP6_ping_land_offline.xml
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_xml/CMIP6_ping_land_offline.xml	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_xml/CMIP6_ping_land_offline.xml	(revision 8430)
@@ -0,0 +1,353 @@
+<!-- ==================================================================================================================== -->
+<!-- CMIP6_ping_land.xml                                                                                                  -->
+<!-- This file is not used while running the model. It is only here for preparing output for CMIP6 simulations.           -->
+<!-- This file contains all output variables in the data request for CMIP6 concerning ORCHIDEE.                           -->
+<!-- field id should not be changed. It is used by the tool dr2xml to produce specific file_def.xml files for CMIP6.      -->
+<!-- field_ref corresponds to field id in field_def_orchidee.xml.                                                         -->
+<!-- field_ref="dummy" means that the corresponding output variable in ORCHIDEE has not yet been identified or coded.     -->
+<!--                                                                                                                      -->
+<!-- $HeadURL$              -->
+<!-- $Date$                                                               -->
+<!-- $Revision$                                                                                                    -->
+<!-- ==================================================================================================================== -->
+
+<!-- Ping files generated by dr2xml 1.16 using Data Request 01.00.28 -->
+<!-- Note that comments are not updated since ping files were generated by dr2xml 0.27 using Data Request 01.00.21 -->
+<!-- lrealms= ['land'] -->
+<!-- exact= False -->
+<!--  listof_home_vars : None
+ tierMax : 3
+ realms_per_context : {'lmdz': ['atmos', 'atmos land'], 'nemo': ['seaIce', 'ocean', 'ocean seaIce', 'ocnBgchem', 'seaIce ocean'], 'orchidee': ['land', 'landIce land', 'land landIce', 'landIce']}
+ max_priority : 3
+ max_file_size_in_floats : 20000000000.0
+ grid_choice : {'IPSL-CM6A-LR': 'LR'}
+ excluded_vars_file : None
+ sizes : {'LR': [20592, 79, 32768, 91, 30, 14, 128]}
+ ping_variables_prefix : CMIP6_
+ source_types : {'IPSL-CM6A-LR': 'AOGCM AER BGC'}
+ path_extra_tables : None
+ grid_policy : native
+ path_special_defs : None
+ mips : {'LR': set(['CDRMIP', 'CORDEX', 'GMMIP', 'RFMIP', 'VolMIP', 'CMIP6', 'ScenarioMIP', 'GeoMIP', 'C4MIP', 'PDRMIP', 'CMIP', 'DECK', 'LUMIP', 'CMIP5', 'CFMIP', 'OMIP', 'DAMIP', 'CCMI', 'SolarMIP', 'VIACSAB', 'SIMIP', 'DCPP', 'ISMIP6', 'AerChemMIP', 'PMIP', 'FAFMIP', 'DynVar', 'LS3MIP', 'SPECS', 'HighResMIP'])}
+ excluded_vars : []
+ orphan_variables : {}
+--> 
+
+<context id="land">
+<field_definition>
+<!-- for variables which realm equals one of _land-->
+   <field id="CMIP6_agesno"        field_ref="snowage_glob"         /> <!-- P1 (day) age_of_surface_snow : age_of_surface_snow -->
+   <field id="CMIP6_agesno"        field_ref="snowage_glob"         /> <!-- P1 (day) age_of_surface_snow : When computing the time-mean here, the time samples, weighted by the mass of snow on the land portion of the grid cell, are accumulated and then divided by the sum of the weights.  Reported as "missing in regions free of snow on land. -->
+   <field id="CMIP6_albc"          field_ref="vegalb_glob"         /> <!-- P1 (1) canopy_albedo : Canopy Albedo -->
+   <field id="CMIP6_albsn"         field_ref="albedo_snow"         /> <!-- P1 (1) snow_and_ice_albedo : Snow Albedo -->
+   <field id="CMIP6_areacella"     field_ref="areas"         /> <!-- P1 (m2) cell_area : Cell areas for any grid used to report atmospheric variables and any other variable using that grid (e.g., soil moisture content). These cell areas should be defined to enable exact calculation of global integrals (e.g., of vertical fluxes of energy at the surface and top of the atmosphere). -->
+   <field id="CMIP6_areacellg"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (m2) cell_area : Cell areas any grid used to report ice sheet variables. These cell areas should be defined to enable exact calculation of area integrals (e.g., of vertical fluxes of energy at the surface and top of the atmosphere) -->
+   <field id="CMIP6_areacellr"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (m2) cell_area : Cell areas for any grid used to report river model variables (may be the same as for atmospheric variables). These cell areas should be defined to enable exact calculation of area integrals (e.g., of vertical fluxes of energy at the surface and top of the atmosphere). -->
+   <field id="CMIP6_ares"          field_ref="raero"         /> <!-- P1 (s m-1) aerodynamic_resistance : aerodynamic_resistance -->
+   <field id="CMIP6_baresoilFrac"  field_ref="baresoilFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by bare soil. Warning: we do not include the bare soil fraction from the vegetated pft's. Note: Multiplied in sechiba by contfrac because we need entire grid-cell -->
+   <field id="CMIP6_burntFractionAll" field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : Percentage of grid cell burned due to all fires including natural and anthropogenic fires and those associated with anthropogenic land use change -->
+   <field id="CMIP6_c13Land"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) total_land_c13 : Mass of 13C in all terrestrial carbon pools -->
+   <field id="CMIP6_c13Litter"     field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_c13_content : Mass of 13C in Litter Pool -->
+   <field id="CMIP6_c13Soil"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) soil_c13_content : Mass of 13C in Soil Pool -->
+   <field id="CMIP6_c13Veg"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) vegetation_c13_content : Mass of 13C in Vegetation -->
+   <field id="CMIP6_c14Land"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) total_land_c14 : Mass of 14C in all terrestrial carbon pools -->
+   <field id="CMIP6_c14Litter"     field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_c14_content : Mass of 14C in Litter Pool -->
+   <field id="CMIP6_c14Soil"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) soil_c14_content : Mass of 14C in Soil Pool -->
+   <field id="CMIP6_c14Veg"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) vegetation_c14_content : only requested for DECK HIST -->
+   <field id="CMIP6_c3PftFrac"     field_ref="c3PftFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by C3 PFTs (including grass, crops, and trees). -->
+   <field id="CMIP6_c4PftFrac"     field_ref="c4PftFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by C4 PFTs (including grass and crops). -->
+   <field id="CMIP6_cCwd"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) wood_debris_carbon_content : Carbon Mass in Coarse Woody Debris -->
+   <field id="CMIP6_cLand"         field_ref="cLand"         /> <!-- P1 (kg m-2) total_land_carbon : Total Carbon in All Terrestrial Carbon Pools -->
+   <field id="CMIP6_cLeaf"         field_ref="cLeaf"         /> <!-- P1 (kg m-2) leaf_carbon_content : Carbon Mass in Leaves -->
+   <field id="CMIP6_cLitter"       field_ref="cLitter"         /> <!-- P1 (kg m-2) litter_carbon_content : Carbon Mass in Litter Pool -->
+   <field id="CMIP6_cLitterAbove"  field_ref="cLitterAbove"         /> <!-- P1 (kg m-2) surface_litter_carbon_content : Carbon Mass in Above-Ground Litter -->
+   <field id="CMIP6_cLitterBelow"  field_ref="cLitterBelow"         /> <!-- P1 (kg m-2) subsurface_litter_carbon_content : Carbon Mass in Below-Ground Litter -->
+   <field id="CMIP6_cLitterCwd"    field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_wood_debris_carbon_content : Carbon Mass in Coarse Woody Debris -->
+   <field id="CMIP6_cLitterGrass"  field_ref="cLitterGrass"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on grass tiles -->
+   <field id="CMIP6_cLitterLut"    field_ref="clitterlut" /> <!-- P1 (kg m-2) litter_carbon_content : carbon  in above and belowground litter pools on land use tiles -->
+   <field id="CMIP6_cLitterShrub"  field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on shrub tiles -->
+   <field id="CMIP6_cLitterSubSurf" field_ref="cLitterBelow"         /> <!-- P2 (kg m-2) subsurface_litter_carbon_content : Carbon Mass in Below-Ground Litter Warning: Duplicate of CMIP6_cLitterBelow -->
+   <field id="CMIP6_cLitterSurf"   field_ref="cLitterAbove"         /> <!-- P2 (kg m-2) surface_litter_carbon_content : Carbon Mass in Above-Ground Litter Warning: Duplicate of CMIP6_cLitterAbove -->
+   <field id="CMIP6_cLitterTree"   field_ref="cLitterTree"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on tree tiles -->
+   <field id="CMIP6_cMisc"         field_ref="cMisc"         /> <!-- P2 (kg m-2) miscellaneous_living_matter_carbon_content : Carbon Mass in Other Living Compartments on Land -->
+   <field id="CMIP6_cOther"        field_ref="cOther"         /> <!-- P2 (kg m-2) other_vegegtation_components_carbon_content : Carbon Mass in Vegetation Components other than Leaves, Stems and Roots -->
+   <field id="CMIP6_cProduct"      field_ref="cProduct"         /> <!-- P1 (kg m-2) carbon_content_of_products_of_anthropogenic_land_use_change : Carbon Mass in Products of Land Use Change -->
+   <field id="CMIP6_cProductLut"   field_ref="cproductlut" /> <!-- P1 (kg m-2) carbon_content_in_wood_and_agricultural_products : wood and agricultural product pool carbon associated with land use tiles; examples of products include paper, cardboard, timber for construction, and crop harvest for food or fuel. -->
+   <field id="CMIP6_cRoot"         field_ref="cRoot"         /> <!-- P1 (kg m-2) root_carbon_content : including fine and coarse roots. -->
+   <field id="CMIP6_cSoil"         field_ref="cSoil"         /> <!-- P1 (kg m-2) soil_carbon_content : Carbon Mass in Soil Pool -->
+   <field id="CMIP6_cSoilAbove1m"  field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) soil_carbon_content : Carbon mass in soil pool above 1m depth -->
+   <field id="CMIP6_cSoilFast"     field_ref="cSoilFast"         /> <!-- P1 (kg m-2) fast_soil_pool_carbon_content : fast is meant as lifetime of less than 10 years for  reference climate conditions (20 C, no water limitations). -->
+   <field id="CMIP6_cSoilGrass"    field_ref="cSoilGrass"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on grass tiles -->
+   <field id="CMIP6_cSoilLevels"   field_ref="dummy_XYSo_not_provided"       /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in each model soil level (summed over all soil carbon pools in that level) -->
+   <field id="CMIP6_cSoilLut"      field_ref="csoillut" /> <!-- P1 (kg m-2) soil_carbon_content : carbon  in soil pool on land use tiles -->
+   <field id="CMIP6_cSoilMedium"   field_ref="cSoilMedium"         /> <!-- P1 (kg m-2) medium_soil_pool_carbon_content : medium is meant as lifetime of more than than 10 years and less than 100 years for  reference climate conditions (20 C, no water limitations) -->
+   <field id="CMIP6_cSoilPools"    field_ref="cSoilPools"/> <!-- P2 (kg m-2) soil_carbon_content_by_pool : Carbon mass in each model soil pool (summed over vertical levels) -->
+   <field id="CMIP6_cSoilShrub"    field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on shrub tiles -->
+   <field id="CMIP6_cSoilSlow"     field_ref="cSoilSlow"         /> <!-- P1 (kg m-2) slow_soil_pool_carbon_content : fast is meant as lifetime of more than 100 years for  reference climate conditions (20 C, no water limitations) -->
+   <field id="CMIP6_cSoilTree"     field_ref="cSoilTree"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on tree tiles -->
+   <field id="CMIP6_cStem"         field_ref="cStem"         /> <!-- P2 (kg m-2) stem_carbon_content : Carbon Mass in Stem -->
+   <field id="CMIP6_cTotFireLut"   field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (kg m-2 s-1)  : Total carbon loss from natural and managed fire on land use tile, including deforestation fires -->
+   <field id="CMIP6_cVeg"          field_ref="cVeg"         /> <!-- P1 (kg m-2) vegetation_carbon_content : Carbon Mass in Vegetation -->
+   <field id="CMIP6_cVegGrass"     field_ref="cVegGrass"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on grass tiles -->
+   <field id="CMIP6_cVegLut"       field_ref="cveglut" /> <!-- P1 (kg m-2) vegetation_carbon_content : carbon in vegetation on land use tiles -->
+   <field id="CMIP6_cVegShrub"     field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on shrub tiles -->
+   <field id="CMIP6_cVegTree"      field_ref="cVegTree"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on tree tiles -->
+   <field id="CMIP6_cWood"         field_ref="cWood"         /> <!-- P2 (kg m-2) wood_carbon_content : Carbon Mass in Wood -->
+   <field id="CMIP6_clayfrac"      field_ref="clayfraction"       /> <!-- P1 (1) volume_fraction_of_clay_in_soil : Clay Fraction -->
+   <field id="CMIP6_cnc"           field_ref="cnc"         /> <!-- P1 (%) vegetation_area_fraction : Canopy covered fraction Warning: fraction over total land -->
+   <field id="CMIP6_cropFrac"      field_ref="cropFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by crop. Warning: Note: Multiplied in sechiba by contfrac because we need entire grid-cell -->
+   <field id="CMIP6_cropFracC3"    field_ref="cropFracC3"         /> <!-- P1 (%) area_fraction : Percentage Cover by C3 Crops -->
+   <field id="CMIP6_cropFracC4"    field_ref="cropFracC4"         /> <!-- P1 (%) area_fraction : Percentage Cover by C4 Crops -->
+   <field id="CMIP6_cw"            field_ref="qsintveg_tot"         /> <!-- P1 (kg m-2) canopy_water_amount : canopy_water_amount -->
+   <field id="CMIP6_dcw"           field_ref="delintercept"         /> <!-- P1 (kg m-2) change_over_time_in_canopy_water_amount : change_over_time_in_canopy_water_amount -->
+   <field id="CMIP6_dgw"           field_ref="delslowr"         /> <!-- P1 (kg m-2) change_over_time_in_groundwater : change_over_time_in_groundwater Warning: It can be either undef or delslowr. We take the second option for the moment. -->
+   <field id="CMIP6_dmlt"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (m) depth_of_subsurface_melting : depth_of_subsurface_melting -->
+   <field id="CMIP6_drivw"         field_ref="delriv"         /> <!-- P1 (kg m-2) change_over_time_in_river_water_amount : change_over_time_in_river_water_amount Warning: we sum the stream and fast reservoir of the routing scheme. -->
+   <field id="CMIP6_dslw"          field_ref="delsoilmoist"         /> <!-- P1 (kg m-2) change_over_time_in_water_content_of_soil_layer : change_over_time_in_water_content_of_soil_layer -->
+   <field id="CMIP6_dsn"           field_ref="delswe"         /> <!-- P1 (kg m-2) change_over_time_in_surface_snow_and_ice_amount : change_over_time_in_surface_snow_and_ice_amount -->
+   <field id="CMIP6_dsw"           field_ref="delsurfwater"         /> <!-- P1 (kg m-2) change_over_time_in_surface_water_amount : change_over_time_in_surface_water_amount Warning: includes the fast reservoire -->
+   <field id="CMIP6_dtes"          field_ref="dtes"         /> <!-- P1 (J m-2) change_over_time_in_thermal_energy_content_of_surface : Change in surface heat storage -->
+   <field id="CMIP6_dtesn"         field_ref="del_snowheattot"         /> <!-- P1 (J m-2) change_over_time_in_thermal_energy_content_of_surface_snow_and_ice : Change in snow/ice cold content Warning: Computed only for the layered scheme on vegetated and bare soil area -->
+   <field id="CMIP6_ec"            field_ref="evspsblveg"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_canopy : liquid_water_evaporation_flux_from_canopy -->
+   <field id="CMIP6_eow"           field_ref="vevapflo"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_open_water : liquid_water_evaporation_flux_from_open_water -->
+   <field id="CMIP6_es"            field_ref="vevapnu"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_soil : liquid_water_evaporation_flux_from_soil -->
+   <field id="CMIP6_esn"           field_ref="vevapsno"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_surface_snow : liquid_water_evaporation_flux_from_surface_snow -->
+   <field id="CMIP6_evspsbl"       field_ref="vevapp"         /> <!-- P1 (kg m-2 s-1) surface_evapotranspiration : surface_evapotranspiration -->
+   <field id="CMIP6_evspsblpot"    field_ref="evapot"         /> <!-- P1 (kg m-2 s-1) water_potential_evaporation_flux : Potential Evapotranspiration -->
+   <field id="CMIP6_evspsblsoi"    field_ref="evspsblsoi"         /> <!-- P1 (kg m-2 s-1) water_evaporation_flux_from_soil : includes sublimation. -->
+   <field id="CMIP6_evspsblveg"    field_ref="evspsblveg"         /> <!-- P1 (kg m-2 s-1) water_evaporation_flux_from_canopy : the canopy evaporation+sublimation (if present in model). Warning: No sublimation here for Orchidee -->
+   <field id="CMIP6_fAnthDisturb"  field_ref="fAnthDisturb"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_anthrogpogenic_emission : carbon mass flux into atmosphere due to any human activity -->
+   <field id="CMIP6_fBNF"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) biological_nitrogen_fixation : biological nitrogen fixation -->
+   <field id="CMIP6_fCLandToOcean" field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_ocean_from_rivers : Lateral transfer of carbon out of gridcell that eventually goes into ocean -->
+   <field id="CMIP6_fDeforestToAtmos" field_ref="fLuc"         /> <!-- P2 (kg m-2 s-1) surface_net_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_anthropogenic_land_use_change : Deforested biomass that goes into atmosphere as a result of anthropogenic land use change Warning : duplicate of variable fLuc -->
+   <field id="CMIP6_fDeforestToProduct" field_ref="fDeforestToProduct"         /> <!-- P1 (kg m-2 s-1) deforested_biomass_into_product_pool_due_to_anthorpogenic_land_use_change : Deforested biomass that goes into product pool as a result of anthropogenic land use change -->
+   <field id="CMIP6_fFire"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_fires_excluding_anthropogenic_land_use_change : CO2 emissions (expressed as a carbon mass flux) from natural fires + human ignition fires as calculated by the fire module of the DGVM, but excluding any CO2 flux from fire included in fLuc, defined below (CO2 Flux to Atmosphere from Land Use Change). -->
+   <field id="CMIP6_fFireAll"      field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_all_sources : Carbon Mass Flux into Atmosphere due to CO2 emissions from Fire resulting from all sources including natural, anthropogenic and land use change. -->
+   <field id="CMIP6_fFireNat"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) fire_CO2_emissions_from_wildfire : Carbon Mass Flux into Atmosphere due to CO2 Emission from natural Fire -->
+   <field id="CMIP6_fGrazing"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_grazing : Carbon Mass Flux into Atmosphere due to Grazing on Land -->
+   <field id="CMIP6_fHarvest"      field_ref="fHarvest"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_crop_harvesting : Carbon Mass Flux into Atmosphere due to Crop Harvesting -->
+   <field id="CMIP6_fHarvestToAtmos" field_ref="fHarvest"         /> <!-- P2 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_crop_harvesting : Harvested biomass that goes straight into atmosphere Warning : Duplicate variable fHarvest -->
+   <field id="CMIP6_fHarvestToProduct" field_ref="fHarvestToProduct"         /> <!-- P1 (kg m-2 s-1) harvested_biomass_into_product_pool : Harvested biomass that goes into product pool -->
+   <field id="CMIP6_fLitterFire"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_litter_carbon : Carbon Mass Flux from Litter, CWD or any non-living pool into Atmosphere due to CO2 Emission from all Fire -->
+   <field id="CMIP6_fLitterSoil"   field_ref="fLitterSoil"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_from_litter : Total Carbon Mass Flux from Litter to Soil -->
+   <field id="CMIP6_fLuc"          field_ref="fLuc"         /> <!-- P1 (kg m-2 s-1) surface_net_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_anthropogenic_land_use_change : Net Carbon Mass Flux into Atmosphere due to Land Use Change -->
+   <field id="CMIP6_fLulccAtmLut"  field_ref="flulccatmlut" /> <!-- P1 (kg s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_direct_to_atmosphere_due_to_anthropogenic_land_use_land_cover_change : carbon transferred directly to atmosphere due to any land-use or land-cover change activities including deforestation or agricultural fire -->
+   <field id="CMIP6_fLulccProductLut" field_ref="flulccproductlut" /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_wood_and_agricultural_product_pools_due_to_anthropogenic_land_use_or_land_cover_change : carbon harvested due to land-use or land-cover change process that enters anthropogenic product pools on tile -->
+   <field id="CMIP6_fLulccResidueLut" field_ref="flulccresiduelut" /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_and_litter_due_to_anthropogenic_land_use_or_land_cover_change : carbon transferred to soil or litter pools due to land-use or land-cover change processes on tile -->
+   <field id="CMIP6_fN2O"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) land_net_n2o_flux : Total land N2O flux -->
+   <field id="CMIP6_fNAnthDisturb" field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_flux_into_atmos_due_to_direct_human_disturbance : nitrogen mass flux out of land due to any human activity -->
+   <field id="CMIP6_fNLandToOcean" field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_ocean_from_rivers : Lateral transfer of nitrogen out of gridcell that eventually goes into ocean -->
+   <field id="CMIP6_fNLitterSoil"  field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_soil_from_litter : Total Nitrogen Mass Flux from Litter to Soil -->
+   <field id="CMIP6_fNOx"          field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) land_net_nox_flux : Total land NOx flux -->
+   <field id="CMIP6_fNProduct"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_to_product_pool_due_to_anthorpogenic_activity : Deforested or harvested biomass as a result of anthropogenic land use or change -->
+   <field id="CMIP6_fNVegLitter"   field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) litter_nitrogen_flux : Total Nitrogen Mass Flux from Vegetation to Litter -->
+   <field id="CMIP6_fNVegSoil"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_soil_from_vegetation_excluding_litter : Total Nitrogen Mass Flux from Vegetation Directly to Soil -->
+   <field id="CMIP6_fNdep"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) deposition_of_nitrogen_onto_land : Dry and Wet Deposition of Reactive Nitrogen onto Land -->
+   <field id="CMIP6_fNfert"        field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) fertiliser_of_nitrogen_onto_land : total N added for cropland fertilisation (artificial and manure) -->
+   <field id="CMIP6_fNgas"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere : Total Nitrogen lost to the atmosphere (sum of NHx, NOx, N2O, N2) -->
+   <field id="CMIP6_fNgasFire"     field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere_due_to_fire : Total N lost to the atmosphere (including NHx, NOx, N2O, N2) from fire. -->
+   <field id="CMIP6_fNgasNonFire"  field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere_not_due_to_fire : Total N lost to the atmosphere (including NHx, NOx, N2O, N2) from all processes except fire. -->
+   <field id="CMIP6_fNleach"       field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost_to_leaching : Total N loss to leaching or runoff (sum of ammonium, nitrite and nitrate) -->
+   <field id="CMIP6_fNloss"        field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost : Total N lost (including NHx, NOx, N2O, N2 and leaching) -->
+   <field id="CMIP6_fNnetmin"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) net_nitrogen_mineralisation : Net nitrogen release from soil and litter as the outcome of nitrogen immobilisation and gross mineralisation -->
+   <field id="CMIP6_fNup"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) plant_nitrogen_uptake : total plant nitrogen uptake (sum of ammonium and nitrate), irrespective of the source of nitrogen -->
+   <field id="CMIP6_fProductDecomp" field_ref="fProductDecomp"         /> <!-- P1 (kg m-2 s-1) Carbon_flux_out_of_storage_product_pools_into_atmos : decomposition out of product pools to CO2 in atmos Warning Duplicated variable with fDeforestToProduct -->
+   <field id="CMIP6_fProductDecompLut" field_ref="flulccatmlut" /> <!-- P1 (kg s-1) tendency_of_atmospheric_mass_content_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_wood_and_agricultural_product_pool : flux from wood and agricultural product pools on land use tile into atmosphere -->
+   <field id="CMIP6_fVegFire"      field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_vegetation_carbon : Carbon Mass Flux from Vegetation into Atmosphere due to CO2 Emission from all Fire -->
+   <field id="CMIP6_fVegLitter"    field_ref="fVegLitter"         /> <!-- P1 (kg m-2 s-1) litter_carbon_flux : Total Carbon Mass Flux from Vegetation to Litter -->
+   <field id="CMIP6_fVegLitterMortality" field_ref="dummy_XY_not_provided"   /> <!-- P2 (kg m-2 s-1) mortality_litter_carbon_flux : Total Carbon Mass Flux from Vegetation to Litter as a Result of Mortality -->
+   <field id="CMIP6_fVegLitterSenescence" field_ref="dummy_XY_not_provided"  /> <!-- P2 (kg m-2 s-1) senescence_litter_carbon_flux : Total Carbon Mass Flux from Vegetation to Litter as a Result of Leaf, Branch, and Root Senescence -->
+   <field id="CMIP6_fVegSoil"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_from_vegetation_excluding_litter : In some models part of carbon (e.g., root exudate) can go directly into the soil pool without entering litter. -->
+   <field id="CMIP6_fVegSoilMortality" field_ref="dummy_XY_not_provided"     /> <!-- P2 (kg m-2 s-1) mortality_vegtosoil_carbon_flux : Total Carbon Mass Flux from Vegetation to Soil as a result of mortality -->
+   <field id="CMIP6_fVegSoilSenescence" field_ref="dummy_XY_not_provided"    /> <!-- P2 (kg m-2 s-1) senescence_vegtosoil_carbon_flux : Total Carbon Mass Flux from Vegetation to Soil as a result of leaf, branch, and root senescence -->
+   <field id="CMIP6_fahLut"        field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upward_heat_flux_due_to_anthropogenic_energy_consumption : Anthropogenic heat flux generated from non-renewable human primary energy consumption, including energy use by vehicles, commercial and residential buildings, industry, and power plants.  Primary energy refers to energy in natural resources, fossil and nonfossil, before conversion into other forms, such as electricity. -->
+   <field id="CMIP6_fldcapacity"   field_ref="fldcapacity"       /> <!-- P1 (%) volume_fraction_of_condensed_water_in_soil_at_field_capacity : Field Capacity -->
+   <field id="CMIP6_fracInLut"     field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (%) area_fraction : annual gross fraction that was transferred into this tile from other land use tiles -->
+   <field id="CMIP6_fracLut"       field_ref="fraclut" /> <!-- P1 (%) area_fraction : fraction of grid cell for each land use tile -->
+   <field id="CMIP6_fracOutLut"    field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (%) area_fraction : annual gross fraction of land use tile  that was transferred into other land use tiles -->
+   <field id="CMIP6_gpp"           field_ref="gpp_ipcc2"         /> <!-- P1 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : only requested for DECK HIST, 1980-present -->
+   <field id="CMIP6_gppGrass"      field_ref="gppgrass"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary production on grass tiles -->
+   <field id="CMIP6_gppLut"        field_ref="gpplut" /> <!-- P1 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary productivity on land use tile -->
+   <field id="CMIP6_gppShrub"      field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary production on Shrub tiles -->
+   <field id="CMIP6_gppTree"       field_ref="gpptree"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary production on tree tiles -->
+   <field id="CMIP6_gppc13"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_c13 : Mass Flux of 13C out of Atmosphere due to Gross Primary Production on Land -->
+   <field id="CMIP6_gppc14"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_c14 : Mass Flux of 14C out of Atmosphere due to Gross Primary Production on Land -->
+   <field id="CMIP6_grassFrac"     field_ref="grassFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell that is covered by natural grass. -->
+   <field id="CMIP6_grassFracC3"   field_ref="grassFracC3"         /> <!-- P1 (%) area_fraction : C3 grass Area Percentage -->
+   <field id="CMIP6_grassFracC4"   field_ref="grassFracC4"         /> <!-- P1 (%) area_fraction : C4 grass Area Percentage -->
+   <field id="CMIP6_hfdsn"         field_ref="snowflxtot"         /> <!-- P1 (W m-2) surface_downward_heat_flux_in_snow : the net downward heat flux from the atmosphere into the snow that lies on land divided by the land area in the grid cell; reported as missing for snow-free land regions or where the land fraction is 0. -->
+   <field id="CMIP6_hfls"          field_ref="fluxlat"           /> <!-- P1 (W m-2) surface_upward_latent_heat_flux : The surface called "surface" means the lower boundary of the atmosphere. "Upward" indicates a vector component which is positive when directed upward (negative downward). The surface latent heat flux is the exchange of heat between the surface and the air on account of evaporation (including sublimation). In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. -->
+   <field id="CMIP6_hflsLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upward_latent_heat_flux : latent heat flux on land use tile -->
+   <field id="CMIP6_hfss"          field_ref="fluxsens"          /> <!-- P1 (W m-2) surface_upward_sensible_heat_flux : The surface called "surface" means the lower boundary of the atmosphere. "Upward" indicates a vector component which is positive when directed upward (negative downward). The surface sensible heat flux, also called "turbulent" heat flux, is the exchange of heat between the surface and the air by motion of air. In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. Unless indicated in the cell_methods attribute, a quantity is assumed to apply to the whole area of each horizontal grid box. Previously, the qualifier where_type was used to specify that the quantity applies only to the part of the grid box of the named type.  Names containing the where_type qualifier are deprecated and newly created data should use the cell_methods attribute to indicate the horizontal area to which the quantity applies. -->
+   <field id="CMIP6_hfssLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upward_sensible_heat_flux : sensible heat flux on land use tile -->
+   <field id="CMIP6_hussLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (1) specific_humidity : near-surface specific humidity on land use tile -->
+   <field id="CMIP6_irrLut"        field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (kg s-1) surface_downward_water_flux_due_to_irrigation : Irrigation flux including any irrigation for crops, trees, pasture, or urban lawns -->
+   <field id="CMIP6_ksat"          field_ref="ksat"       /> <!-- P1 (1e-6 m s-1)  : Saturated Hydraulic Conductivity -->
+   <field id="CMIP6_lai"           field_ref="lai_ipcc"         /> <!-- P1 (1) leaf_area_index : a ratio obtained by dividing the total upper leaf surface area of vegetation by the (horizontal) surface area of the land on which it grows. Warning: here we take the average over the entire land fraction; not sure it's ok with the DataRequest comment "a ratio obtained by dividing the total upper leaf surface area of vegetation by the (horizontal) surface area of the land on which it grows." PC+JG : lai_ipcc and laimean are related to the same land fraction(note veget_max in stomate_lpj is not the same veget_max in sechiba!). We see other differencies between these output variables coming mainly from pft3 and some from 6,8,9,12. -->
+   <field id="CMIP6_laiLut"        field_ref="lailut" /> <!-- P1 (1)  : Leaf Area Index on Land Use Tile -->
+   <field id="CMIP6_landCoverFrac" field_ref="landCoverFrac" /> <!-- P1 (%) area_fraction : The categories may differ from model to model, depending on their  PFT definitions.   This may include natural PFTs, anthropogenic PFTs, bare soil, lakes, urban areas, etc.   Sum of all should equal the fraction of the grid-cell that is land. Warning: Note: here not multiplying by contfrac according to DR -->
+   <field id="CMIP6_lwsnl"         field_ref="snowliqtot"         /> <!-- P1 (kg m-2) liquid_water_content_of_snow_layer : where land over land: this is computed as the total mass of liquid water contained interstitially within the snow layer of the land portion of a grid cell divided by the area of the land portion of the cell. Warning: Computed only for the layered scheme on vegetated and bare soil area. -->
+   <field id="CMIP6_mrfso"         field_ref="humtot_frozen"         /> <!-- P1 (kg m-2) soil_frozen_water_content : the mass (summed over all all layers) of frozen water. Warning: To be calculated. -->
+   <field id="CMIP6_mrfsofr"       field_ref="profil_froz_hydro"       /> <!-- P1 (1) mass_fraction_of_frozen_water_in_soil_moisture : mass_fraction_of_frozen_water_in_soil_layer -->
+   <field id="CMIP6_mrlqso"        field_ref="profil_liquid_hydro"       /> <!-- P1 (1) mass_fraction_of_unfrozen_water_in_soil_moisture : mass_fraction_of_unfrozen_water_in_soil_layer -->
+   <field id="CMIP6_mrlso"         field_ref="humtot_liquid"         /> <!-- P1 (kg m-2) soil_liquid_water_content : Soil Liquid Water Content -->
+   <field id="CMIP6_mrro"          field_ref="mrro"         /> <!-- P1 (kg m-2 s-1) runoff_flux : the total runoff (including "drainage" through the base of the soil model) leaving the land portion of the grid cell divided by the land area in the grid cell, averaged over the 3-hour interval. -->
+   <field id="CMIP6_mrroLi"        field_ref="dummy_XY_not_provided"  /> <!-- P1 (kg m-2 s-1) land_ice_runoff_flux : Runoff flux over land ice is the difference between any available liquid water in the snowpack less any refreezing. Computed as the sum of rainfall and melt of snow or ice less any refreezing or water retained in the snowpack -->
+   <field id="CMIP6_mrroLut"       field_ref="mrro_lut" /> <!-- P1 (kg m-2 s-1) runoff_flux : Total runoff from land use tile -->
+   <field id="CMIP6_mrrob"         field_ref="drainage"         /> <!-- P1 (kg m-2 s-1) subsurface_runoff_flux : subsurface_runoff_flux -->
+   <field id="CMIP6_mrros"         field_ref="runoff"         /> <!-- P1 (kg m-2 s-1) surface_runoff_flux : surface_runoff_flux -->
+   <field id="CMIP6_mrsfl"         field_ref="soilmoist_frozen"       /> <!-- P1 (kg m-2) frozen_moisture_content_of_soil_layer : Frozen water content of soil layer -->
+   <field id="CMIP6_mrsll"         field_ref="soilmoist_liquid"       /> <!-- P1 (kg m-2) liquid_moisture_content_of_soil_layer : Liquid water content of soil layer -->
+   <field id="CMIP6_mrso"          field_ref="humtot"         /> <!-- P1 (kg m-2) soil_moisture_content : the mass per unit area  (summed over all soil layers) of water in all phases. -->
+   <field id="CMIP6_mrsoLut"       field_ref="humtot_lut" /> <!-- P1 (kg m-2) soil_moisture_content : Total soil moisture -->
+   <field id="CMIP6_mrsofc"        field_ref="tmcfc"         /> <!-- P1 (kg m-2) soil_moisture_content_at_field_capacity : reported "where land": divide the total water holding capacity of all the soil in the grid cell by the land area in the grid cell;  reported as "missing" where the land fraction is 0. -->
+   <field id="CMIP6_mrsol"         field_ref="soilmoist"       /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : Total water content of soil layer -->
+   <field id="CMIP6_mrsos"         field_ref="humtot_top"         /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : the mass of water in all phases in a thin surface soil layer. -->
+   <field id="CMIP6_mrsosLut"      field_ref="humtot_top_lut" /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : Moisture in Upper Portion of Soil Column of land use tile -->
+   <field id="CMIP6_mrsow"         field_ref="dummy_not_provided"         /> <!-- P1 (1) volume_fraction_of_condensed_water_in_soil_at_field_capacity : relative_soil_moisture_content_above_field_capacity Warning: weird mention to field capacity in the description, overlooked. AD: 3 differents definintions, we do not know what to do -->
+   <field id="CMIP6_mrtws"         field_ref="tws"         /> <!-- P1 (kg m-2) total_water_storage : canopy_and_surface_and_subsurface_water_amount -->
+   <field id="CMIP6_nLand"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) total_land_nitrogen : Total nitrogen in all terrestrial nitrogen pools -->
+   <field id="CMIP6_nLeaf"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) leaf_nitrogen_content : Nitrogen Mass in Leaves -->
+   <field id="CMIP6_nLitter"       field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) litter_nitrogen_content : Nitrogen Mass in Litter Pool -->
+   <field id="CMIP6_nLitterCwd"    field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) litter_wood_debris_nitrogen_content : Nitrogen Mass in Coarse Woody Debris -->
+   <field id="CMIP6_nLitterSubSurf" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) subsurface_litter_nitrogen_content : Nitrogen Mass in below ground litter (non CWD) -->
+   <field id="CMIP6_nLitterSurf"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) surface_litter_nitrogen_content : Nitrogen Mass in above ground litter (non CWD) -->
+   <field id="CMIP6_nMineral"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) mineral_soil_nitrogen_content : Mineral nitrogen in the soil -->
+   <field id="CMIP6_nMineralNH4"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) mineral_nh4_soil_nitrogen_content : Mineral ammonium in the soil -->
+   <field id="CMIP6_nMineralNO3"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) mineral_no3_soil_nitrogen_content : Mineral nitrate in the soil -->
+   <field id="CMIP6_nOther"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) other_vegegtation_components_nitrogen_content : Nitrogen mass in vegetation components other than leaves, stem and root -->
+   <field id="CMIP6_nProduct"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) nitrogen_content_of_products_of_anthropogenic_land_use_change : Nitrogen Mass in Products of Land Use Change -->
+   <field id="CMIP6_nRoot"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) root_nitrogen_content : Nitrogen Mass in Roots -->
+   <field id="CMIP6_nSoil"         field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) soil_nitrogen_content : Nitrogen Mass in Soil Pool -->
+   <field id="CMIP6_nStem"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2) stem_nitrogen_content : Nitrogen Mass in Stem -->
+   <field id="CMIP6_nVeg"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) vegetation_nitrogen_content : Nitrogen Mass in Vegetation -->
+   <field id="CMIP6_nbp"           field_ref="nbp"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : This is the net mass flux of carbon between land and atmosphere calculated as photosynthesis MINUS the sum of  plant and soil respiration, carbonfluxes  from fire, harvest, grazing  and land use change. Positive flux  is into the land. -->
+   <field id="CMIP6_necbLut"       field_ref="necbLut" /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : net rate of C accumulation (or loss) on land use tile -->
+   <field id="CMIP6_nep"           field_ref="nep"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes_excluding_anthropogenic_land_use_change : Net Ecosystem Exchange -->
+   <field id="CMIP6_netAtmosLandC13Flux" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) net_atmos_to_land_C13_flux : Net Mass Flux of 13C between atmosphere and land (positive into land) as a result of all processes. -->
+   <field id="CMIP6_netAtmosLandC14Flux" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) net_atmos_to_land_C14_flux : Net Mass Flux of 14C between atmosphere and land (positive into land) as a result of all processes. -->
+   <field id="CMIP6_netAtmosLandCO2Flux" field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : Net flux of CO2 between atmosphere and land (positive into land) as a result of all processes. Warning: Could be done in Orchidee but not considered as a priority  -->
+   <field id="CMIP6_npp"           field_ref="npp_ipcc"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : Carbon Mass Flux out of Atmosphere due to Net Primary Production on Land -->
+   <field id="CMIP6_nppGrass"      field_ref="nppGrass"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary production on grass tiles -->
+   <field id="CMIP6_nppLeaf"       field_ref="nppLeaf"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_leaves : This is the rate of carbon uptake by leaves due to NPP -->
+   <field id="CMIP6_nppLut"        field_ref="npplut" /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary productivity on land use tile -->
+   <field id="CMIP6_nppOther"      field_ref="nppOther"         /> <!-- P2 (kg m-2 s-1) net_primary_production_allocated_to_other : net primary production allcoated to other pools (not leaves stem or roots) -->
+   <field id="CMIP6_nppRoot"       field_ref="nppRoot"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_roots : This is the rate of carbon uptake by roots due to NPP -->
+   <field id="CMIP6_nppShrub"      field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary production on Shrub tiles -->
+   <field id="CMIP6_nppStem"       field_ref="nppStem"         /> <!-- P2 (kg m-2 s-1) net_primary_production_allocated_to_stem : net primary production allcoated to stem -->
+   <field id="CMIP6_nppTree"       field_ref="nppTree"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary production on tree tiles -->
+   <field id="CMIP6_nppWood"       field_ref="nppWood"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_wood : This is the rate of carbon uptake by wood due to NPP -->
+   <field id="CMIP6_nudgincsm"     field_ref="nudgincsm"         /> <!-- P1 (kg m-2) nudging_increment_in_water_content_of_soil_layer : nudging_increment_in_water_content_of_soil_layer -->
+   <field id="CMIP6_nudgincswe"    field_ref="nudgincswe"         /> <!-- P1 (kg m-2) nudging_increment_in_surface_snow_and_ice_amount : nudging_increment_in_surface_snow_and_ice_amount -->
+   <field id="CMIP6_nwdFracLut"    field_ref="nwdFraclut" /> <!-- P1 (%)  : fraction of land use tile tile that is non-woody vegetation ( e.g. herbaceous crops) -->
+   <field id="CMIP6_orog"          field_ref="dummy_XY"         /> <!-- P1 (m) surface_altitude : Surface Altitude -->
+   <field id="CMIP6_orog_ist"      field_ref="dummy_XY"         /> <!-- P1 (m) surface_altitude : This is needed in case the ice sheet elevation changes in time -->
+   <field id="CMIP6_pastureFrac"   field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by anthropogenic pasture. -->
+   <field id="CMIP6_pastureFracC3" field_ref="dummy_XY_not_provided"         /> <!-- P2 (%) area_fraction : C3 Pasture Area Percentage -->
+   <field id="CMIP6_pastureFracC4" field_ref="dummy_XY_not_provided"         /> <!-- P2 (%) area_fraction : C4 Pasture Area Percentage -->
+   <field id="CMIP6_pflw"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) liquid_water_content_of_permafrost_layer : "where land over land", i.e., this is the total mass of liquid water contained within the permafrost layer within the land portion of a grid cell divided by the area of the land portion of the cell. -->
+   <field id="CMIP6_prra"          field_ref="precip_rain"      /> <!-- P1 (kg m-2 s-1) rainfall_flux : over Land Ice//quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_prsn"          field_ref="precip_snow"      /> <!-- P1 (kg m-2 s-1) snowfall_flux : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_prveg"         field_ref="prveg"         /> <!-- P1 (kg m-2 s-1) precipitation_flux_onto_canopy : the precipitation flux that is intercepted by the vegetation canopy (if present in model) before reaching the ground. -->
+   <field id="CMIP6_qgwr"          field_ref="drainage"         /> <!-- P1 (kg m-2 s-1) water_flux_from_soil_layer_to_groundwater : water_flux_from_soil_layer_to_groundwater Warning: It can be either undef or drainage. We take the second option for the moment. -->
+   <field id="CMIP6_rGrowth"       field_ref="rGrowth_ipcc"         /> <!-- P1 (kg m-2 s-1) surface_upward_carbon_mass_flux_due_to_plant_respiration_for_biomass_growth : Carbon Mass Flux into Atmosphere due to Growth Autotrophic Respiration on Land Warning: Variable coming from stomate, can only be provided for daily or monthly output with Orchidee. -->
+   <field id="CMIP6_rMaint"        field_ref="rMaint_ipcc"         /> <!-- P1 (kg m-2 s-1) surface_upward_carbon_mass_flux_due_to_plant_respiration_for_biomass_maintenance : Carbon Mass Flux into Atmosphere due to Maintenance Autotrophic Respiration on Land Warning: Variable coming from stomate, can only be provided for daily or monthly output with Orchidee. -->
+   <field id="CMIP6_ra"            field_ref="ra"         /> <!-- P1 (kg m-2 s-1) plant_respiration_carbon_flux : only requested for DECK HIST, 1980-present Warning: Variable coming from stomate, can only be provided for daily or monthly output with Orchidee. -->
+   <field id="CMIP6_raGrass"       field_ref="raGrass"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : autotrophic respiration on grass tiles -->
+   <field id="CMIP6_raLeaf"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_leaves : Total respiration from leaves -->
+   <field id="CMIP6_raLut"         field_ref="ralut" /> <!-- P1 (kg m-2 s-1) plant_respiration_carbon_flux : plant respiration on land use tile -->
+   <field id="CMIP6_raOther"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration : Total respiration from other pools (not leaves stem or roots) -->
+   <field id="CMIP6_raRoot"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_roots : Total Respiration from Roots -->
+   <field id="CMIP6_raShrub"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : autotrophic respiration on Shrub tiles -->
+   <field id="CMIP6_raStem"        field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_stem : Total Respiration from Stem -->
+   <field id="CMIP6_raTree"        field_ref="raTree"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : autotrophic respiration on tree tiles -->
+   <field id="CMIP6_rac13"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) plant_respiration_c13_flux : Mass Flux of 13C into Atmosphere due to Autotrophic (Plant) Respiration on Land -->
+   <field id="CMIP6_rac14"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) plant_respiration_c14_flux : Mass Flux of 14C into Atmosphere due to Autotrophic (Plant) Respiration on Land -->
+   <field id="CMIP6_residualFrac"  field_ref="residualFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is land and is covered by "non-vegetation" and "non-bare-soil" (e.g., urban, ice, lakes, etc.) -->
+   <field id="CMIP6_rh"            field_ref="rh_ipcc2"         /> <!-- P1 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : Carbon Mass Flux into Atmosphere due to Heterotrophic Respiration on Land Warning:  Issue with duplicated variables resp_hetero from sechiba and stomate but they are calculated differently. We here need the sechiba variable for 3h freq output. -->
+   <field id="CMIP6_rhGrass"       field_ref="rhGrass"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : heterotrophic respiration on grass tiles -->
+   <field id="CMIP6_rhLitter"      field_ref="rhLitter"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux_from_litter : Carbon Mass Flux into Atmosphere due to Heterotrophic Respiration from Litter on Land -->
+   <field id="CMIP6_rhLut"         field_ref="rhlut" /> <!-- P1 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : soil heterotrophic respiration on land use tile -->
+   <field id="CMIP6_rhShrub"       field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : heterotrophic respiration on Shrub tiles -->
+   <field id="CMIP6_rhSoil"        field_ref="rhSoil"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux_from_soil : Carbon Mass Flux into Atmosphere due to Heterotrophic Respiration from Soil on Land -->
+   <field id="CMIP6_rhTree"        field_ref="rhTree"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : heterotrophic respiration on tree tiles -->
+   <field id="CMIP6_rhc13"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_c13_flux : Mass Flux of 13C into Atmosphere due to Heterotrophic Respiration on Land -->
+   <field id="CMIP6_rhc14"         field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_c14_flux : Mass Flux of 14C into Atmosphere due to Heterotrophic Respiration on Land -->
+   <field id="CMIP6_rivi"          field_ref="dummy_XY_not_provided"         /> <!-- P1 (m3 s-1) water_flux_from_upstream : water_flux_to_downstream -->
+   <field id="CMIP6_rivo"          field_ref="hydrographs"         /> <!-- P1 (m3 s-1) water_flux_to_downstream : water_flux_from_upstream -->
+   <field id="CMIP6_rlds"          field_ref="lwdown"           /> <!-- P1 (W m-2) surface_downwelling_longwave_flux_in_air : The surface called "surface" means the lower boundary of the atmosphere. "longwave" means longwave radiation. Downwelling radiation is radiation from above. It does not mean "net downward". When thought of as being incident on a surface, a radiative flux is sometimes called "irradiance". In addition, it is identical with the quantity measured by a cosine-collector light-meter and sometimes called "vector irradiance". In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. -->
+   <field id="CMIP6_rlus"          field_ref="lwdown"    >   lwdown - lwnet </field> <!-- P1 (W m-2) surface_upwelling_longwave_flux_in_air : The surface called "surface" means the lower boundary of the atmosphere. "longwave" means longwave radiation. Upwelling radiation is radiation from below. It does not mean "net upward". When thought of as being incident on a surface, a radiative flux is sometimes called "irradiance". In addition, it is identical with the quantity measured by a cosine-collector light-meter and sometimes called "vector irradiance". In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. -->
+   <field id="CMIP6_rlusLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upwelling_longwave_flux_in_air : Surface Upwelling Longwave on Land Use Tile -->
+   <field id="CMIP6_rootd"         field_ref="zmaxh"         /> <!-- P1 (m) root_depth : report the maximum soil depth reachable by plant roots (if defined in model), i.e., the maximum soil depth from which they can extract moisture; report as "missing" where the land fraction is 0. -->
+   <field id="CMIP6_rootdsl"       field_ref="dummy_XYSo"       /> <!-- P1 (kg m-2) root_mass_content_of_carbon : Root Distribution -->
+   <field id="CMIP6_rsds"          field_ref="swdown"         /> <!-- P1 (W m-2) surface_downwelling_shortwave_flux_in_air : surface solar irradiance for UV calculations -->
+   <field id="CMIP6_rsus"          field_ref="swdown"   >   swdown - swnet </field> <!-- P1 (W m-2) surface_upwelling_shortwave_flux_in_air : The surface called "surface" means the lower boundary of the atmosphere. "shortwave" means shortwave radiation. Upwelling radiation is radiation from below. It does not mean "net upward". When thought of as being incident on a surface, a radiative flux is sometimes called "irradiance". In addition, it is identical with the quantity measured by a cosine-collector light-meter and sometimes called "vector irradiance". In accordance with common usage in geophysical disciplines, "flux" implies per unit area, called "flux density" in physics. -->
+   <field id="CMIP6_rsusLut"       field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (W m-2) surface_upwelling_shortwave_flux_in_air : Surface Upwelling Shortwave  on Land Use Tile -->
+   <field id="CMIP6_rzwc"          field_ref="humtot"         /> <!-- P1 (kg m-2) water_content_of_root_zone : water_content_of_root_zone -->
+   <field id="CMIP6_sandfrac"      field_ref="sandfraction"       /> <!-- P1 (1)  : Sand Fraction -->
+   <field id="CMIP6_sftgif"        field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) land_ice_area_fraction : Fraction of Grid Cell Covered with Glacier -->
+   <field id="CMIP6_shrubFrac"     field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by shrub. -->
+   <field id="CMIP6_slthick"       field_ref="dlh"       /> <!-- P1 (m)  : Thickness of Soil Layers -->
+   <field id="CMIP6_snc"           field_ref="frac_snow"         /> <!-- P1 (%) surface_snow_area_fraction : Fraction of each grid cell that is occupied by snow that rests on land portion of cell. -->
+   <field id="CMIP6_snc_ist"       field_ref="dummy_ist"         /> <!-- P1 (%) surface_snow_area_fraction : quantity averaged over ice sheet  only, to avoid contamination from other surfaces (eg: permafrost) -->
+   <field id="CMIP6_snd"           field_ref="snowdepth"         /> <!-- P1 (m) surface_snow_thickness : where land over land, this is computed as the mean thickness of snow in the land portion of the grid cell (averaging over the entire land portion, including the snow-free fraction).  Reported as missing where the land fraction is 0. Warning: Computed and weigthed only for the layered scheme on vegetated and bare soil area. -->
+   <field id="CMIP6_snm_land"      field_ref="snowmelt"         /> <!-- P1 (kg m-2 s-1) surface_snow_melt_flux : Computed as the total surface melt water on the land portion of the grid cell divided by the land area in the grid cell; report as 0.0 for snow-free land regions; report as missing where the land fraction is 0. -->
+   <field id="CMIP6_snm_land"      field_ref="snowmelt"         /> <!-- P1 (kg m-2 s-1) surface_snow_melt_flux : surface_snow_and_ice_melt_flux -->
+   <field id="CMIP6_snm_ist"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_snow_melt_flux : Surface Snow Melt -->
+   <field id="CMIP6_snw"           field_ref="snow"         /> <!-- P1 (kg m-2) surface_snow_amount : Computed as the mass of surface snow on the land portion of the grid cell divided by the land area in the grid cell; reported as missing where the land fraction is 0; excluded is snow on vegetation canopy or on sea ice. -->
+   <field id="CMIP6_sootsn"        field_ref="dummy_XY_not_provided"         /> <!-- P1 (kg m-2) soot_content_of_surface_snow : the entire land portion of the grid cell is considered, with snow soot content set to 0.0 in regions free of snow. -->
+   <field id="CMIP6_sw"            field_ref="surfwater"         /> <!-- P1 (kg m-2) surface_water_amount_assuming_no_snow : surface_water_amount_assuming_no_snow Warning: includes the fast reservoire -->
+   <field id="CMIP6_sweLut"        field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (m)  : snow water equivalent on land use tile -->
+   <field id="CMIP6_tSoilPools"    field_ref="tSoilPools"/> <!-- P2 (s-1) soil_carbon_turnover_rate_by_pool : turnover rate of each model soil carbon pool -->
+   <field id="CMIP6_tas"           field_ref="temp_air"         /> <!-- P1 (K) air_temperature : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_tasLut"        field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (K) air_temperature : near-surface air temperature (2m above displacement height, i.e. t_ref) on land use tile -->
+   <field id="CMIP6_tcs"           field_ref="dummy_XY_not_provided"         /> <!-- P1 (K) canopy_temperature : Vegetation Canopy Temperature -->
+   <field id="CMIP6_tgs"           field_ref="dummy_XY_not_provided"         /> <!-- P1 (K) surface_temperature : Temperature of bare soil -->
+   <field id="CMIP6_tpf"           field_ref="dummy_XY_not_provided"         /> <!-- P1 (m) permafrost_layer_thickness : where land over land: This is the mean thickness of the permafrost layer in the land portion of the grid cell.  Reported as missing in permafrost-free regions. Warning: not yet computed but maybe doable following MICT -->
+   <field id="CMIP6_tran"          field_ref="tran"         /> <!-- P1 (kg m-2 s-1) transpiration_flux : Transpiration -->
+   <field id="CMIP6_treeFrac"      field_ref="treeFrac"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by trees. -->
+   <field id="CMIP6_treeFracBdlDcd" field_ref="treeFracBdlDcd"         /> <!-- P1 (%) area_fraction : Broadleaf deciduous tree fraction -->
+   <field id="CMIP6_treeFracBdlEvg" field_ref="treeFracBdlEvg"         /> <!-- P1 (%) area_fraction : Broadleaf evergreen tree fraction -->
+   <field id="CMIP6_treeFracNdlDcd" field_ref="treeFracNdlDcd"         /> <!-- P1 (%) area_fraction : Needleleaf deciduous tree fraction -->
+   <field id="CMIP6_treeFracNdlEvg" field_ref="treeFracNdlEvg"         /> <!-- P1 (%) area_fraction : Needleleaf evergreen tree fraction -->
+   <field id="CMIP6_treeFracPrimDec" field_ref="treeFracPrimDec"         /> <!-- P1 (%) area_fraction : This is the fraction of the entire grid cell  that is covered by "total primary deciduous trees." -->
+   <field id="CMIP6_treeFracPrimEver" field_ref="treeFracPrimEver"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by primary evergreen trees. -->
+   <field id="CMIP6_treeFracSecDec" field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by secondary deciduous trees. -->
+   <field id="CMIP6_treeFracSecEver" field_ref="dummy_XY_not_provided"         /> <!-- P1 (%) area_fraction : fraction of entire grid cell  that is covered by secondary evergreen trees. -->
+   <field id="CMIP6_ts"            field_ref="temp_sol_new"         /> <!-- P1 (K) surface_temperature : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_tsl"           field_ref="ptn"       /> <!-- P1 (K) soil_temperature : Temperature of single near-surface soil layer.  Reported as "missing" for grid cells occupied entirely by "sea". -->
+   <field id="CMIP6_tslsi"         field_ref="temp_sol_new"         /> <!-- P1 (K) surface_temperature : Surface temperature of all surfaces except open ocean. -->
+   <field id="CMIP6_tslsiLut"      field_ref="dummy_XY_landUse_not_provided" /> <!-- P1 (K) surface_temperature : Surface Temperature on Landuse Tile -->
+   <field id="CMIP6_tsn_land"      field_ref="dummy_XY"         /> <!-- P1 (K) temperature_in_surface_snow : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_tsn_ist"       field_ref="dummy_XY"         /> <!-- P1 (K) temperature_in_surface_snow : quantity averaged over ice sheet (grounded ice sheet and floating ice shelf) only. Needed to analyse the impact of downscaling methods -->
+   <field id="CMIP6_tsn_land"      field_ref="dummy_XY_not_provided"         /> <!-- P1 (K) temperature_in_surface_snow : This temperature is averaged over all the snow in the grid cell that rests on land or land ice.  When computing the time-mean here, the time samples, weighted by the mass of snow on the land portion of the grid cell, are accumulated and then divided by the sum of the weights.   Reported as "missing in regions free of snow on land. Warning: Doable but painful with the two different snow schemes. -->
+   <field id="CMIP6_vegFrac"       field_ref="vegFrac"         /> <!-- P1 (%) area_fraction : Total vegetated fraction -->
+   <field id="CMIP6_vegHeight_land" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over all vegetation types and over the vegetated fraction of a grid cell. -->
+   <field id="CMIP6_vegHeight_veg" field_ref="dummy_XY_not_provided"         /> <!-- P1 (m) canopy_height : Vegetation height averaged over all vegetation types and over the vegetated fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightCrop" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the crop fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightGrass" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the grass fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightPasture" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the pasture fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightShrub" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the shrub fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightTree" field_ref="dummy_XY_not_provided"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the tree fraction of a grid cell. -->
+   <field id="CMIP6_wetlandCH4"    field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) wetland_methane_emissions : Grid averaged methane emissions from wetlands -->
+   <field id="CMIP6_wetlandCH4cons" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) wetland_methane_consumption : Grid averaged methane consuption (methanotrophy) from wetlands -->
+   <field id="CMIP6_wetlandCH4prod" field_ref="dummy_XY_not_provided"         /> <!-- P2 (kg m-2 s-1) wetland_methane_production : Grid averaged methane production (methanogenesis) from wetlands -->
+   <field id="CMIP6_wetlandFrac"   field_ref="dummy_XY_not_provided"         /> <!-- P2 (%) wetland_fraction : Fraction of a grid cell covered by wetland. -->
+   <field id="CMIP6_wilt"          field_ref="wilt"       /> <!-- P1 (%) volume_fraction_of_condensed_water_in_soil_at_wilting_point : Wilting Point -->
+   <field id="CMIP6_wtd"           field_ref="dummy_XY_not_provided"         /> <!-- P1 (m) depth_of_soil_moisture_saturation : depth_of_soil_moisture_saturation -->
+
+<!--  Variable added for ORCHIDEE offline simulations -->
+<!--  Note also that variables CMIP6_tas and CMIP6_ts above are changed -->
+   <field id="CMIP6_siltfrac"  field_ref="siltfraction"       /> <!-- P1 (1) volume_fraction_of_silt_in_soil : Silt Fraction -->
+   <field id="CMIP6_pr"        field_ref="precip_rain" >  precip_rain + precip_snow </field> <!-- Precipitation-->
+   <field id="CMIP6_hfdsl"     field_ref="soilflx"       /> <!-- Downward Heat Flux at Land Surface-->
+   <field id="CMIP6_rls"       field_ref="lwnet"       /> <!-- Net Longwave Surface Radiation -->
+   <field id="CMIP6_rss"       field_ref="swnet"       /> <!-- Net Shortwave Surface Radiation -->
+   <field id="CMIP6_tasmax"    field_ref="tasmax"       /> <!-- Daily Maximum Near-Surface Air Temperature -->
+   <field id="CMIP6_tasmin"    field_ref="tasmin"       /> <!-- Daily Minimum Near-Surface Air Temperature -->
+   <field id="CMIP6_tr"        field_ref="temp_sol_new"       /> <!-- Surface Radiative Temperature -->
+   <field id="CMIP6_tsland"    field_ref="temp_sol_new"       /> <!-- Surface Temperature -->
+   <field id="CMIP6_huss"      field_ref="qair"       /> <!-- Near-Surface Specific Humidity -->
+   <field id="CMIP6_sfcWind"   field_ref="wind"       /> <!-- Near-Surface Wind Speed -->
+</field_definition>
+</context>
Index: /branches/publications/ORCHIDEE-AFP/src_xml/context_input_orchidee.xml
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_xml/context_input_orchidee.xml	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_xml/context_input_orchidee.xml	(revision 8430)
@@ -0,0 +1,349 @@
+<!-- =========================================================================================================== -->
+<!-- ORCHIDEE context for input files                                                                            -->
+<!-- context_input_orchidee.xml : Configuration file for ORCHIDEE for reading of input files using XIOS          -->
+<!-- This file must be included from iodef.xml                                                                   -->
+<!-- All specifications specific for the reading and interpolating of input files are regrouped in this file.    -->
+<!-- Find below sections for file_definition, field_definition, domain_definition, grid_definition and           -->
+<!-- variable_definition.                                                                                        -->
+<!--                                                                                                             -->
+<!-- $HeadURL$                -->
+<!-- $Date$                                                      -->
+<!-- $Revision$                                                                                           -->
+<!-- =========================================================================================================== -->
+<context id="orchidee">
+
+
+  <!-- ========================================================================================================= -->
+  <!-- Definition of input files                                                                                 -->
+  <!-- The input files are activated or desactivated from the source code depending on simulation set up.        -->
+  <!-- The variables are here on the input source grid.                                                          -->
+  <!-- Different treatment are done accordig to the file.                                                        -->
+  <!-- Values higher than 1e10 are for some files considered as missing values and the field is then set to 0.   -->
+  <!-- A normalization are sometimes done with the fraction of the grid cell.                                    -->
+  <!-- Sometimes, if only missing values are found for a grid cell, then a default value is set.                 -->
+  <!-- ========================================================================================================= -->
+ 
+  <file_definition>
+
+    <file id="soils_param_file" mode="read" output_freq="1y" enabled="true">
+      <field id="soilcolor" name="soilcolor" domain_ref="soil" operation="instant" freq_offset="1ts"/>
+      <field id="soiltext" name="soiltext" domain_ref="soil" operation="instant" freq_offset="1ts"/>
+    </file>
+    
+    <file  id="PFTmap_file"  mode="read" output_freq="1y">
+      <field id="maxvegetfrac_read"  name="maxvegetfrac" domain_ref="pft" axis_ref="nvm" operation="instant"  freq_offset="1ts"> this &lt; 1e10 ? this : 0 </field>
+      <field id="maxvegetfrac_mask"  name="maxvegetfrac" domain_ref="pft" axis_ref="nvm" operation="instant"  freq_offset="1ts"> this &lt; 1e10 ? 1 : 0 </field>
+    </file>
+    
+    <file id="topography_file"  mode="read" output_freq="1y">
+      <!--      <field id="pente"  domain_ref="topo"  operation="instant"  freq_offset="1ts" > (this &gt; 1e10) ? 1 : this </field>     ==> In reference, missing value are use for computing, this probably wrong -->
+      <field id="pente_read"       name="pente" domain_ref="topo"  operation="instant"  freq_offset="1ts" > ((this/$slope_noreinf) &lt; 1)? this/$slope_noreinf : 1 </field>
+      <field id="mask_pente_read"  name="pente" domain_ref="topo"  operation="instant"  freq_offset="1ts" > (this &lt; $min_sechiba)? 0 : 1                         </field>  <!-- create mask -->
+    </file>
+    
+    <file id="albedo_file" mode="read" output_freq="1y">
+      <field id="mask_alb_read"    name="mask"       domain_ref="albedo"  operation="instant"  freq_offset="1ts" />
+      <field id="bg_alb_vis_read"  name="bg_alb_vis" domain_ref="albedo"  operation="instant"  freq_offset="1ts" >  mask_alb_read &gt; 0.99 ? this : $missing_value  </field>
+      <field id="bg_alb_nir_read"  name="bg_alb_nir" domain_ref="albedo"  operation="instant"  freq_offset="1ts" >  mask_alb_read &gt; 0.99 ? this : $missing_value  </field>
+    </file>
+    
+    <file id="lai_file" mode="read" output_freq="1y" time_counter_name="toto" cyclic="true">
+      <field id="lai_read"       name="LAI" grid_ref="lai" operation="instant"  freq_offset="1ts" > this &gt; 20 ? 0 : this </field>
+      <field id="mask_lai_read"  name="LAI" grid_ref="lai" operation="instant"  freq_offset="1ts" > this &gt; 20 ? 0 : 1    </field>  <!-- create mask -->
+    </file>
+
+    <file id="fertilizer_file" mode="read" output_freq="1y" cyclic="true">
+      <field id="N_qt_OTHER_year_read"  name="N_qt_OTHER_year" domain_ref="fertilizer" operation="instant"  freq_offset="1ts"/>
+      <field id="N_qt_WRICE_year_read"  name="N_qt_WRICE_year" domain_ref="fertilizer" operation="instant"  freq_offset="1ts"/>
+    </file>
+    
+    <file id="bbg_clim_file" mode="read" output_freq="1y" cyclic="true">
+      <field id="flx_co2_bbg_year_read"  name="flx_co2_bbg_year" domain_ref="bbg_clim" operation="instant"  freq_offset="1ts"/>
+    </file>
+    
+    <file id="reftemp_file" mode="read" output_freq="1y" cyclic="true">
+      <field id="reftemp_read"  name="temperature" domain_ref="reftemp" operation="instant"  freq_offset="1ts"/>
+    </file>
+    
+    <file id="woodharvest_file" mode="read" output_freq="1y" cyclic="true">
+      <field id="woodharvest_read"  name="woodharvest" domain_ref="woodharvest" operation="instant"  freq_offset="1ts"/>
+    </file>
+    
+    
+    
+    <file id="interp_diag" output_freq="1ts" sync_freq="1ts" enabled=".FALSE.">
+      <field_group domain_ref="domain_landpoints" operation="once" default_value="9.96921e+36">
+        <field id="interp_diag_aveget" name="aveget" />
+        <field id="interp_diag_vegetrefrac" name="vegetrefrac" axis_ref="nvm"/>
+        <field id="interp_diag_atext" name="atext" />
+        <field id="interp_diag_soilclass" name="soilclass"     axis_ref="ncsm"/>
+        <field id="interp_diag_clayfraction" name="clayfraction"  />
+        <field id="interp_diag_aslope" name="aslope"    />
+        <field id="interp_diag_reinf_slope" name="reinf_slope"  />
+	
+        <field id="interp_diag_alb_vis" name="alb_vis"  />
+        <field id="interp_diag_alb_nir" name="alb_nir"  />
+	
+        <field id="interp_diag_N_qt_WRICE_year" name="wrice"  />
+        <field id="interp_diag_N_qt_OTHER_year" name="other"  />
+        <field id="interp_diag_flx_co2_bbg_year" name="co2_bbg"  />
+	
+      </field_group>
+      <field id="interp_diag_lai" grid_ref="from_lai" name="lai"  operation="once" default_value="9.96921e+36" enabled="false"/>
+      <field field_ref="mask_alb_read" operation="once" default_value="9.96921e+36"  freq_offset="0ts" enabled="false"/>
+    </file>
+
+
+    <file id="nudge_moistc" name="nudge_moistc" type="one_file" mode="read" output_freq="1d">
+      <field  id="moistc_in" name="moistc" operation="instant" grid_ref="grid_inputfile_moistc" freq_offset="1ts" > (this &gt; 1e10) ? 0 : this </field>
+      <field  id="mask_moistc_in" name="moistc" operation="instant" grid_ref="grid_inputfile_moistc" freq_offset="1ts" > (this &gt; 1e10) ? 0 : 1 </field>
+    </file>
+    
+    <file id="nudge_snow" name="nudge_snow" type="one_file" mode="read" output_freq="1d">
+      <field  id="snowdz_in" name="snowdz" operation="instant" grid_ref="grid_inputfile_snow" freq_offset="1ts" > (this &gt; 1e10) ? 0 : this </field>
+      <field  id="snowrho_in" name="snowrho" operation="instant" grid_ref="grid_inputfile_snow" freq_offset="1ts" > (this &gt; 1e10) ? 0 : this </field>
+      <field  id="snowtemp_in" name="snowtemp" operation="instant" grid_ref="grid_inputfile_snow" freq_offset="1ts" > (this &gt; 1e10) ? 0 : this </field>
+      <field  id="mask_snow_in" name="snowdz" operation="instant" grid_ref="grid_inputfile_snow" freq_offset="1ts" > (this &gt; 1e10) ? 0 : 1 </field>
+    </file>
+    
+  </file_definition>
+
+
+  <!-- ========================================================================================================= -->
+  <!-- Definition of all field coming from files but now interpolated to the model grid.                         -->
+  <!-- ========================================================================================================= -->
+
+  <field_definition>
+
+    <field_group enabled="false" read_access="true">
+
+      <field_group id="soil_color" enabled="false">
+        <field id="soilcolor0" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 0 </field>
+        <field id="soilcolor1" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 1 </field>
+        <field id="soilcolor2" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 2 </field>
+        <field id="soilcolor3" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 3 </field>
+        <field id="soilcolor4" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 4 </field>
+        <field id="soilcolor5" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 5 </field>
+        <field id="soilcolor6" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 6 </field>
+        <field id="soilcolor7" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 7 </field>
+        <field id="soilcolor8" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 8 </field>
+        <field id="soilcolor9" field_ref="soilcolor" domain_ref="from_soil" > soilcolor == 9 </field>
+      </field_group>
+
+      <field_group id="soil_text" field_ref="soiltext" domain_ref="from_soil" enabled="true" read_access="true">
+        <field id="soiltext1"  > soiltext == 1 </field>
+        <field id="soiltext2"  > soiltext == 2 </field>
+        <field id="soiltext3"  > soiltext == 3 </field>
+        <field id="soiltext4"  > soiltext == 4 </field>
+        <field id="soiltext5"  > soiltext == 5 </field>
+        <field id="soiltext6"  > soiltext == 6 </field>
+        <field id="soiltext7"  > soiltext == 7 </field>
+        <field id="soiltext8"  > soiltext == 8 </field>
+        <field id="soiltext9"  > soiltext == 9 </field>
+        <field id="soiltext10" > soiltext == 10 </field>
+        <field id="soiltext11" > soiltext == 11 </field>
+        <field id="soiltext12" > soiltext == 12 </field>
+      </field_group>
+      
+
+      <field id="frac_veget"      field_ref="maxvegetfrac_read" domain_ref="from_pft" read_access="true" enabled="true" />
+      <field id="frac_veget_frac" field_ref="maxvegetfrac_mask" domain_ref="from_pft" read_access="true" enabled="true" />
+
+      <field id="slope_tmp"           field_ref="pente_read"       domain_ref="from_topo"                                  />
+      <field id="frac_slope_interp"   field_ref="mask_pente_read"  domain_ref="from_topo" read_access="true" enabled="true"/>
+      <field id="reinf_slope_interp"                               domain_ref="from_topo" read_access="true" enabled="true"> (frac_slope_interp &gt; $min_sechiba ) ? 1-slope_tmp/(frac_slope_interp+1e-100) : $slope_default </field>
+
+      <field id="bg_alb_vis_tmp"   field_ref="bg_alb_vis_read"  domain_ref="from_albedo"  />
+      <field id="bg_alb_vis_interp" field_ref="bg_alb_vis_tmp"  read_access="true" enabled="true" > this == $missing_value ? $albbg_vis_default : this </field>
+
+      <field id="bg_alb_nir_tmp"    field_ref="bg_alb_nir_read"  domain_ref="from_albedo"  />
+      <field id="bg_alb_nir_interp" field_ref="bg_alb_nir_tmp"  read_access="true"  enabled="true" >  this == $missing_value ? $albbg_nir_default : this </field>
+      
+      <field id="lai_tmp"          field_ref="lai_read"      grid_ref="from_lai" />
+      <field id="frac_lai_interp"  field_ref="mask_lai_read" grid_ref="from_lai" read_access="true" enabled="true" />
+      <field id="lai_interp"       field_ref="lai_tmp"                           read_access="true" enabled="true"  >  lai_tmp/(frac_lai_interp+1e-100) </field>  <!-- renormalize -->
+      
+      <field id="N_qt_WRICE_year_interp"  field_ref="N_qt_WRICE_year_read"  domain_ref="from_fertilizer" read_access="true" enabled="true" />
+      <field id="N_qt_OTHER_year_interp"  field_ref="N_qt_OTHER_year_read"  domain_ref="from_fertilizer" read_access="true" enabled="true" />
+      
+      <field id="flx_co2_bbg_year_interp"  field_ref="flx_co2_bbg_year_read"  domain_ref="from_bbg_clim" read_access="true" enabled="true" />
+
+      <field id="reftemp_interp"  field_ref="reftemp_read"  domain_ref="from_reftemp" read_access="true" enabled="true" />
+
+      <field id="woodharvest_interp"  field_ref="woodharvest_read"  domain_ref="from_woodharvest" read_access="true" enabled="true" />
+      
+    </field_group>
+
+    <field_group id="orchidee_input_mc" grid_ref="grid_nslm_nstm">
+      <!-- Interpolate the mask. This gives now the fraction of the source area underlaying the model grid cell -->
+      <field id="mask_moistc_interp" field_ref="mask_moistc_in" read_access="true" />
+      <!-- Interpolate the variable. Note that where the source file had missing values, the variables was set to 0. Therefor normalization is needed.     -->
+      <!-- Normalize the interpolated values with the mask which corresponds to the fraction of underlaying valid source grid cells.                       -->
+      <!-- The default value 0.2 is used if the mask is 0. This is the case if no information at all was found on the source grid for the model grid cell. -->
+      <field id="moistc_tmp" field_ref="moistc_in"  />
+      <field id="moistc_interp" field_ref="moistc_tmp" read_access="true" > (mask_moistc_interp &lt; 1e-4) ? 0.2 : this/(mask_moistc_interp+1e-100) </field>
+    </field_group>
+
+    <field_group id="orchidee_input_snow" grid_ref="grid_nsnow2" >
+      <field id="mask_snow_interp" field_ref="mask_snow_in" read_access="true" />
+      <field id="snowdz_tmp" field_ref="snowdz_in" />
+      <!-- Set snowdz=0 where no information found on source grid, for all other points normlize with the fracion of underlaying source grid cells      -->
+      <field id="snowdz_interp" field_ref="snowdz_tmp" read_access="true" > (mask_snow_interp &lt; 1e-4) ? 0 : this/(mask_snow_interp+1e-100) </field>
+      <field id="snowrho_tmp" field_ref="snowrho_in" />
+      <!-- Set snowrho=50 where no information found on source grid, for all other points normlize with the fracion of underlaying source grid cells    -->
+      <field id="snowrho_interp" field_ref="snowrho_tmp" read_access="true" > (mask_snow_interp &lt; 1e-4) ? 50 : this/(mask_snow_interp+1e-100) </field>
+      <field id="snowtemp_tmp" field_ref="snowtemp_in" />
+      <!-- Set snowtemp=273 where no information found on source grid, for all other points normlize with the fracion of underlaying source grid cells  -->
+      <field id="snowtemp_interp" field_ref="snowtemp_tmp" read_access="true" > (mask_snow_interp &lt; 1e-4) ? 273 : this/(mask_snow_interp+1e-100) </field>
+    </field_group>
+ 
+  </field_definition>
+
+
+
+  <!-- =========================================================================================================== -->
+  <!-- Definition of a horizontal domain for each input file                                                       -->
+  <!-- =========================================================================================================== -->
+
+  <domain_definition>
+
+    <domain id="domain_inputfile_moistc" type="rectilinear">
+      <generate_rectilinear_domain />
+    </domain>
+    
+    <domain id="domain_inputfile_snow" type="rectilinear">
+      <generate_rectilinear_domain />
+    </domain>
+    
+    <domain id="from_soil" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="false"/>
+    </domain>
+    
+    <domain id="from_pft" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="false" />
+    </domain>
+    
+    <domain id="from_topo" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="false" />
+    </domain>
+    
+    <domain id="from_albedo" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="true" detect_missing_value="true"/>
+    </domain>
+    
+    <domain id="from_lai" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="false" />
+    </domain>
+    
+    <domain id="from_bbg_clim" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="false" />
+    </domain>
+    
+    <domain id="from_fertilizer" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="false" />
+    </domain>
+    
+    <domain id="from_reftemp" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="false" />
+    </domain>
+    
+    <domain id="from_woodharvest" domain_ref="domain_landpoints">
+      <interpolate_domain order="1" renormalize="false" />
+    </domain>
+    
+    <domain id="soil" type="rectilinear">
+      <!-- generate_rectilinear_domain bounds_lon_start="-180" bounds_lon_end="180" bounds_lat_start="-90" bounds_lat_end="90"/-->
+      <generate_rectilinear_domain bounds_lon_start="-180" bounds_lon_end="180" bounds_lat_start="90" bounds_lat_end="-90"/>
+    </domain>
+    
+    <domain id="pft" type="rectilinear">
+      <generate_rectilinear_domain/>
+    </domain>
+    
+    <domain id="topo" type="rectilinear">
+      <generate_rectilinear_domain/>
+    </domain>
+    
+    <domain id="albedo" type="rectilinear">
+      <generate_rectilinear_domain />
+    </domain>
+    
+    <domain id="lai" type="rectilinear">
+      <generate_rectilinear_domain/>
+    </domain>
+    
+    <domain id="bbg_clim" type="rectilinear">
+      <generate_rectilinear_domain/>
+    </domain>
+    
+    <domain id="fertilizer" type="rectilinear">
+      <generate_rectilinear_domain/>
+    </domain>
+
+    <domain id="reftemp" type="rectilinear">
+      <generate_rectilinear_domain/>
+    </domain>
+
+    <domain id="woodharvest" type="rectilinear">
+      <generate_rectilinear_domain/>
+    </domain>
+    
+  </domain_definition>
+
+
+  <!-- =========================================================================================================== -->
+  <!-- Definition of input grids                                                                        -->
+  <!-- =========================================================================================================== -->
+
+  <grid_definition>
+
+    <grid id="grid_inputfile_moistc">
+      <domain domain_ref="domain_inputfile_moistc"/>
+      <axis axis_ref="nslm" />
+      <axis axis_ref="nstm" />
+    </grid>  
+
+    <grid id="grid_inputfile_snow">
+      <domain domain_ref="domain_inputfile_snow"/>
+      <axis axis_ref="nsnow" />
+    </grid>  
+    
+    <grid id="from_lai">
+      <domain domain_ref="from_lai" />
+      <axis axis_ref="nvm" />
+      <axis axis_ref="lai_time" />
+    </grid>
+    
+    <grid id="lai">
+      <domain domain_ref="lai" />
+      <axis axis_ref="nvm" />
+      <axis axis_ref="lai_time" />
+    </grid>
+    
+    <grid id="grid_nsnow2">
+      <domain domain_ref="domain_landpoints" >
+        <interpolate_domain order="1"/>
+      </domain>
+      <axis axis_ref="nsnow" />
+    </grid>
+
+  </grid_definition>
+  
+  
+  <!-- =========================================================================================================== -->
+  <!-- Variable denfinition needed for interpolation of input files                                                -->
+  <!-- The values for below variables are set from the fortran code.                                               -->
+  <!-- =========================================================================================================== -->
+
+  <variable_definition>
+    
+    <variable id="slope_default" type="double">xxx</variable>
+    <variable id="slope_noreinf" type="double">xxx</variable>
+    <variable id="min_sechiba" type="double">xxx</variable>
+    <variable id="albbg_vis_default" type="double">xxx</variable>
+    <variable id="albbg_nir_default" type="double">xxx</variable>
+    
+  </variable_definition>
+  
+
+</context>
Index: /branches/publications/ORCHIDEE-AFP/src_xml/context_orchidee.xml
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_xml/context_orchidee.xml	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_xml/context_orchidee.xml	(revision 8430)
@@ -0,0 +1,256 @@
+<!-- =========================================================================================================== -->
+<!-- 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 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>
+
+    <!-- Model horizontal domain -->
+    <domain id="domain_landpoints"/>
+
+    <!-- Standard output horizontal domain:                                                                         -->
+    <!-- The same as the model grid is used by default for regular longitude-latitude grid. If the model is running -->
+    <!-- on an unstructred grid, this domain_landpoints will be changed to domain_landoints_regular, see below.     -->   
+    <domain id="domain_landpoints_out" domain_ref="domain_landpoints"/>
+
+    <!-- Interpolated output horizontal domain:                                                                   -->
+    <!-- This domain is used for output when the modele is running on an unstructured grid. For that case,        -->
+    <!-- the ORCHIDEE fortran code will switch so that domain_landpoints_out make reference to this domain.       -->
+    <domain id="domain_landpoints_regular" ni_glo="144" nj_glo="142" type="rectilinear"  >
+      <generate_rectilinear_domain/>
+      <interpolate_domain order="1" renormalize="true" detect_missing_value="true"/>
+    </domain>
+
+    <!-- Output horizontal domain used for CMIP6 simulations:                                                    -->
+    <!-- This domain is only used when running with the workflow CMIP6 and dr2xml_orchidee.xml files.            -->
+    <domain id="greordered"  domain_ref="domain_landpoints">
+      <reorder_domain invert_lat="true" shift_lon_fraction="0.5" min_lon="0" max_lon="360" />
+    </domain>
+    
+  </domain_definition>
+
+  <!-- =========================================================================================================== -->
+  <!-- Definition of vertical axis and extra dimensions                                                            -->
+  <!-- =========================================================================================================== -->
+  <axis_definition>
+    <!-- Vertical axis and extra dimensions -->
+    <axis id="nvm" name="veget" standard_name="model_level_number" long_name="Vegetation types" unit="1"/>
+    <axis id="nlut" name="nlut" standard_name="landusetype4" long_name="Number of land use types specified by LUMIP" unit="1"/>
+    <axis id="ncarb" name="ncarb" standard_name="ncarb" long_name="Number of soil carbon pools" 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="ncsm" name="ncsm"    standard_name="model_level_number" long_name="Soil type" unit="1"/>
+    <axis id="nsnow" name="snowlev" standard_name="model_level_number" long_name="Snow levels" unit="1"/>
+    <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="lai_time" />
+  </axis_definition>
+
+
+  <!-- =========================================================================================================== -->
+  <!-- Definition of model and output grids                                                                        -->
+  <!-- A grid is a combination of the horizontal domain and optionally one or several axes.                        -->
+  <!-- All grids are specified twice: the grid used by the model "grid_axis", and the grid used for output         -->
+  <!-- "grid_axis_out", where "axis" represents one or several axes used in the grid, see below.                   -->
+  <!-- When the model runs on the default regular longitude-latitude grid, "grid_axis_out" is the same as          -->
+  <!-- "grid_axis", no interpolation will be done. When the model runs on an unstructured grid, grid_axis_out is   --> 
+  <!-- different from grid_axis and XIOS will do the interpolation.                                                -->
+  <!-- =========================================================================================================== -->
+  <grid_definition>
+
+    <!-- Definition of horizontal grid, 2D grid -->
+    <grid id="grid_landpoints">
+      <domain domain_ref="domain_landpoints" />
+    </grid>
+    <grid id="grid_landpoints_out">
+      <domain domain_ref="domain_landpoints_out" />
+    </grid>
+
+    <!-- Definition of grids with fields having one extra dimension (one vertical axis or another dimension), 3D grids -->
+    <grid id="grid_nvm">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="nvm" />
+    </grid>
+    <grid id="grid_nvm_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nvm" />
+    </grid>
+
+    <grid id="grid_nlut">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="nlut" />
+    </grid>
+    <grid id="grid_nlut_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nlut" />
+    </grid>
+    
+    <grid id="grid_ncarb">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="ncarb" />
+    </grid>
+    <grid id="grid_ncarb_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="ncarb" />
+    </grid>
+    
+    <grid id="grid_nstm">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="nstm" />
+    </grid>
+    <grid id="grid_nstm_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nstm" />
+    </grid>
+
+    <grid id="grid_nslm">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="nslm" />
+    </grid>
+    <grid id="grid_nslm_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nslm" />
+    </grid>
+
+    <grid id="grid_ngrnd">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="ngrnd" />
+    </grid>
+    <grid id="grid_ngrnd_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="ngrnd" />
+    </grid>
+
+    <grid id="grid_albtyp">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="albtyp" />
+    </grid>
+    <grid id="grid_albtyp_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="albtyp" />
+    </grid>
+
+    <grid id="grid_nnobio">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="nnobio" />
+    </grid>
+    <grid id="grid_nnobio_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nnobio" />
+    </grid>
+
+    <grid id="grid_nlaip1">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="nlaip1" />
+    </grid>
+    <grid id="grid_nlaip1_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nlaip1" />
+    </grid>
+
+    <grid id="grid_nsnow">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="nsnow" />
+    </grid>
+    <grid id="grid_nsnow_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nsnow" />
+    </grid>
+
+    <grid id="grid_P10">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="P10" />
+    </grid>
+    <grid id="grid_P10_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="P10" />
+    </grid>
+    
+    <grid id="grid_P11">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="P11" />
+    </grid>
+    <grid id="grid_P11_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="P11" />
+    </grid>
+
+    <grid id="grid_P100">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="P100" />
+    </grid>
+    <grid id="grid_P100_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="P100" />
+    </grid>
+
+    <grid id="grid_P101">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="P101" />
+    </grid>
+    <grid id="grid_P101_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="P101" />
+    </grid>
+
+
+    <!-- Definition of grids with fields having two extra dimensions, 4D grids -->
+    <grid id="grid_nslm_nstm">
+      <domain domain_ref="domain_landpoints" >
+        <interpolate_domain order="1"/>
+      </domain>
+      <axis axis_ref="nslm" />
+      <axis axis_ref="nstm" />
+    </grid>
+    <grid id="grid_nslm_nstm_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nslm" />
+      <axis axis_ref="nstm" />
+    </grid>
+
+    <grid id="grid_nvm_nstm">
+      <domain domain_ref="domain_landpoints" />
+      <axis axis_ref="nvm" />
+      <axis axis_ref="nstm" />
+    </grid>
+    <grid id="grid_nvm_nstm_out">
+      <domain domain_ref="domain_landpoints_out" />
+      <axis axis_ref="nvm" />
+      <axis axis_ref="nstm" />
+    </grid>
+
+  </grid_definition>
+  
+  
+</context>
Index: /branches/publications/ORCHIDEE-AFP/src_xml/field_def_orchidee.xml
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_xml/field_def_orchidee.xml	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_xml/field_def_orchidee.xml	(revision 8430)
@@ -0,0 +1,655 @@
+<!-- =========================================================================================================== -->
+<!-- field_def_orchidee.xml : Definition of all existing output variables                                        -->
+<!-- This file must only be changed if a call xios_orchidee_send_field is added, changed or removed.             -->
+<!--                                                                                                             -->
+<!-- $HeadURL$              -->
+<!-- $Date$                                                     -->
+<!-- $Revision$                                                                                           -->
+<!-- =========================================================================================================== -->
+
+<field_definition prec="4" operation="average" freq_op="1ts" enabled=".TRUE." default_value="9.96921e+36" detect_missing_value=".TRUE.">
+
+  <!-- ========================================================================================================= -->
+  <!-- Definition of field_group "remap_expr" used to intrepolate output fields.                                 -->
+  <!-- expr is set from the fortran source code for the case with unstructured grid, for regular grid it'll      -->
+  <!-- remain empty and no interpolations will be done for output fields.                                        -->
+  <!-- ========================================================================================================= -->
+  <field_group id="remap_expr" expr="_reset_" prec="_reset_" operation="_reset_" freq_op="_reset_" enabled="_reset_" default_value="_reset_" detect_missing_value="_reset_"/>
+  
+
+  <!-- ========================================================================================================= -->
+  <!-- Definition of output variables in sechiba                                                                 -->
+  <!-- ========================================================================================================= -->
+
+  <field_group id="sechiba" grid_ref="grid_landpoints">
+    <field id="areas" name="Areas" long_name="Mesh areas" unit="m2" operation="once" freq_offset="0ts" />
+    <field id="LandPoints" name="LandPoints" long_name="Land Points" unit="1" operation="once" freq_offset="0ts"/>
+    <field id="contfrac" name="Contfrac" long_name="Continental fraction" unit="1" operation="once" freq_offset="0ts"/>
+    <field id="zmaxh" name="zmaxh" long_name="Hydrologic soil depth" unit="m" operation="once" freq_offset="0ts"/>
+    <field id="ptn" name="ptn" long_name="Deep ground temperature" unit="K" grid_ref="grid_ngrnd"/>
+    <field id="npp" name="npp" long_name="Net Primary Production (positive from atm to land)" unit="gC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="q_cdrag" name="cdrag" long_name="Drag coefficient for LE and SH" unit="-"/>
+    <field id="soilalb_bg" name="soilalb_bg" long_name="Background bare soil albedo obained from MODIS related data-set" unit="1" grid_ref="grid_albtyp" operation="once" freq_offset="0ts"/>
+    <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="vegalb_glob" name="vegalb_glob" long_name="Mean Vegetation Albedo" unit="1"> (vegalb_vis + vegalb_nir)*0.5 </field>
+    <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" freq_offset="0ts"/>
+    <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" freq_offset="0ts"/>
+    <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" freq_offset="0ts"/>
+    <field id="areftemp" name="areftemp" long_name="Availability of data for the reftemp interpolation (negative values if no data found)" unit="1"  operation="once" freq_offset="0ts"/>
+    <field id="vevapp" name="evap_sec" long_name="Total Evaporation" unit="kg/m^2/s"/>
+    <field id="vevapp_day" name="evap" field_ref="vevapp" long_name="Evaporation per day" unit="mm/d" > vevapp*86400  </field>
+    <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="kg/m^2/s"/>
+    <field id="temp_sol_new" name="AvgSurfT" long_name="Average surface temperature" unit="K"/>
+    <field id="temp_sol_new_C" name="temp_sol" field_ref="temp_sol_new" long_name="Average surface temperature" unit="C" > temp_sol_new - 273.15  </field>
+    <field id="tsol_max" name="tsol_max" field_ref="temp_sol_new_C" long_name="Maximum Surface Temperature" unit="C" operation="maximum"/>
+    <field id="tsol_min" name="tsol_min" field_ref="temp_sol_new_C" long_name="Minimum Surface Temperature" unit="C" operation="minimum"/>
+    <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/s"/>
+    <field id="precip_snow" name="precip_snow" long_name="Snowfall rate" unit="mm/s"/>
+    <field id="netrad" name="netrad" long_name="Net radiation" unit="W/m^2"/>
+    <field id="lai" name="lai" long_name="Leaf Area Index per PFT" unit="1" grid_ref="grid_nvm"/>
+    <!--liuly add -->
+    <field id="oLtoLSR" name="oldLtoLSR" long_name="Old LtoLSR" unit="1"/>
+    <field id="oRtoLSR" name="oldRtoLSR" long_name="Old RtoLSR" unit="1"/>
+    <field id="oStoLSR" name="oldStoLSR" long_name="Old StoLSR" unit="1"/>
+    <field id="gstot_lly" name="gstot_lly" long_name="total stomatal conductance to H2O in diffuco.f90 exported by lyliu" unit="1"/>
+    <!--liuly Below add based on xchen AP-->
+    <field id="LtoLSR" name="LtoLSR" long_name="LtoLSR" unit="1"/>
+    <field id="RtoLSR" name="RtoLSR" long_name="RtoLSR" unit="1"/>
+    <field id="StoLSR" name="StoLSR" long_name="StoLSR" unit="1"/>
+    <field id="LSR" name="LSR" long_name="LSR" unit="1"/>
+    <field id="LAI_CL1" name="LAI_CL1" long_name="Leaf Area Index of leaf age class 1" unit="1" grid_ref="grid_nvm"/>
+    <field id="LAI_CL2" name="LAI_CL2" long_name="Leaf Area Index of leaf age class 2" unit="1" grid_ref="grid_nvm"/>
+    <field id="LAI_CL3" name="LAI_CL3" long_name="Leaf Area Index of leaf age class 3" unit="1" grid_ref="grid_nvm"/>
+    <field id="LAI_CL4" name="LAI_CL4" long_name="Leaf Area Index of leaf age class 4" unit="1" grid_ref="grid_nvm"/>
+    <field id="Gc" name="Gc" long_name="Gs/VPD" unit="molCO2 m-2 s-1 kPa-1" grid_ref="grid_nvm"/>
+    <field id="Gs" name="Gs" long_name="beta for CO2" unit="molCO2 m-2 s-1" grid_ref="grid_nvm"/>
+    <field id="FAPAR" name="FAPAR" long_name="fraction of absorved PAR" unit="-" grid_ref="grid_nvm"/>
+    <field id="PAR_xc" name="PAR_xc" long_name="PAR_xc" unit="umol photons m^-2/s" grid_ref="grid_nvm"/>
+    <field id="LUE" name="LUE" long_name="gpp/(PAR*FAPAR)" unit="gC/umol photons" grid_ref="grid_nvm"/>
+    <field id="PC" name="PC" long_name="gpp/PAR" unit="gC/umol photons" grid_ref="grid_nvm"/>
+    <field id="PC_wu" name="PC_wu" long_name="sum(a_CL*LAI_CL)/sum(LAI_CL)*FAPAR" unit="gC/umol photons" grid_ref="grid_nvm"/>
+    <field id="PC_xc" name="PC_xc" long_name="sum(a_CL*LAI_CL)/sum(LAI_CL)*FAPAR" unit="gC/umol photons" grid_ref="grid_nvm"/>
+    <field id="GPP_CL1" name="GPP_CL1" long_name="Gross primary productivity (positive from atm to land)" unit="gC/day/m^2" grid_ref="grid_nvm"/>
+    <field id="GPP_CL2" name="GPP_CL2" long_name="Gross primary productivity (positive from atm to land)" unit="gC/day/m^2" grid_ref="grid_nvm"/>
+    <field id="GPP_CL3" name="GPP_CL3" long_name="Gross primary productivity (positive from atm to land)" unit="gC/day/m^2" grid_ref="grid_nvm"/>
+    <field id="GPP_CL4" name="GPP_CL4" long_name="Gross primary productivity (positive from atm to land)" unit="gC/day/m^2" grid_ref="grid_nvm"/>
+    <field id="GPP_xc" name="GPP_xc" long_name="Gross primary productivity (positive from atm to land)" unit="gC/day/m^2" grid_ref="grid_nvm"/>
+
+    <!--liuly Above add based on xchen AP-->
+    <!--liulyc below add-->
+    <field id="VPD" name="VPD" long_name="vapor pressue deficit" unit="kpa"/>
+    <field id="VPD_lly" name="VPD_lly" long_name="vapor pressue deficit in diffuco_trans_co2" unit="kpa"/>
+    <field id="fVPD" name="fVPD" long_name="fVPD" unit="kpa"/> 
+    <field id="SVP" name="SVP" long_name="vapor pressue deficit" unit="kpa"/>
+
+    <!--liulye add to check turnover rate-->
+    <field id="Turnover_rate_ori" name="Turnover_rate_ori" long_name="Turnover rate default" unit="unitless"/>
+    <field id="Turnover_rate_vpd" name="Turnover_rate_vpd" long_name="Turnover rate triggered by vpd" unit="unitless"/>
+    <field id="Turnover_rate_sw" name="Turnover_rate_sw" long_name="Turnover rate triggered by sw" unit="unitless"/>
+    <field id="Turnover_rate_pre" name="Turnover_rate_pre" long_name="Turnover rate triggered by precipitation" unit="unitless"/>
+    <field id="Turnover_rate_final" name="Turnover_rate_final" long_name="Maximum Turnover rate triggered by vpd, sw, and precipitation" unit="unitless"/>
+    <field id="Pre_weekly" name="Pre_weekly" long_name="Weekly mean Pre" unit="mm/day"/>
+    <field id="SWdown_weekly" name="SWdown_weekly" long_name="Weekly mean SWdown" unit="W/m-2"/>
+    <field id="VPD_weekly" name="VPD_weekly" long_name="Weekly mean VPD" unit="kpa"/>
+
+
+
+    
+
+    <field id="alaimap" name="alaimap" long_name="Availability of data for the lai interpolation (negative values if no data found)" unit="1"  operation="once" freq_offset="0ts"/>
+    <field id="reinf_slope" name="reinf_slope" long_name="Slope index for each grid box" unit="1" operation="once" freq_offset="0ts"/>
+    <field id="aslope" name="aslope" long_name="Availability of data for the slope interpolation (negative values if no data found)" unit="1"  operation="once" freq_offset="0ts"/>
+    <field id="njsc" name="soilindex" long_name="Index of soil texture" unit="1" operation="once" freq_offset="0ts"/>
+    <field id="clayfraction" name="clayfraction" long_name="Fraction of clay particles in soil (grid-cell mean)" unit="1" grid_ref="grid_nslm" operation="once" freq_offset="0ts"/>
+    <field id="sandfraction" name="sandfraction" long_name="Fraction of sand particles in soil (grid-cell mean)" unit="1" grid_ref="grid_nslm" operation="once" freq_offset="0ts"/>
+    <field id="siltfraction" name="siltfraction" long_name="Fraction of silt particles in soil (grid-cell mean)" unit="1" grid_ref="grid_nslm" operation="once" freq_offset="0ts"/>
+    <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" grid_ref="grid_nstm" > this*86400 </field>
+    <field id="drainage_soil" name="drainage_soil" long_name="Drainage for soil type" unit="mm/d" grid_ref="grid_nstm" > this*86400 </field>
+    <field id="transpir_soil" name="transpir_soil" long_name="Transpir for soil type" unit="mm/d" grid_ref="grid_nstm" > this*86400 </field>
+    <field id="runoff_soil" name="runoff_soil" long_name="Runoff for soil type" unit="mm/d" grid_ref="grid_nstm" > this*86400 </field>
+    <field id="temp_air" name="tair" long_name="Air Temperature" unit="K"/>
+    <field id="tairmax" field_ref="temp_air" name="tairmax" long_name="Maximum air temperature for the period of the output frequency" unit="K" operation="maximum"/>
+    <field id="tasmax" field_ref="tairmax" name="tasmax" long_name="Daily maximum of the Air Temperature" unit="K" operation="average" freq_op="1d"> @tairmax </field>
+    <field id="tairmin" field_ref="temp_air" name="tairmin" long_name="Minimum air temperature for the period of the output frequency" unit="K" operation="minimum"/>
+    <field id="tasmin" field_ref="tairmin" name="tasmin" long_name="Daily minimum of the Air Temperature" unit="K" operation="average" freq_op="1d"> @tairmin </field>
+    <field id="qair" name="qair" long_name="Air Humidity" unit="g/g"/>
+    <field id="roughheight" name="roughheight" long_name="Effective roughness height" unit="m"/>
+    <field id="transpir" name="transpir" long_name="Transpiration" unit="mm/d" grid_ref="grid_nvm"/>
+    <field id="inter" name="inter" long_name="Interception loss" unit="mm/d" grid_ref="grid_nvm"/>
+    <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 on vegetated and bare soil area" unit="d"/>
+    <field id="snownobio" name="snownobio" long_name="Snow on nobio area" unit="kg/m^2" grid_ref="grid_nnobio"/>
+    <field id="snownobioage" name="snownobioage" long_name="Snow age on nobio area" unit="d" grid_ref="grid_nnobio"/>
+    <field id="snowage_glob" name="snowage_glob" long_name="Snow age on total area including snow on vegetated and bare soil and nobio area" unit="d"/>
+    <field id="frac_snow" name="frac_snow" long_name="Snow fraction on total area including snow on vegetated and bare soil and nobio area" unit="%" > this*100 </field>
+    <field id="frac_snow_veg" name="frac_snow_veg" long_name="Snow fraction on vegetated area" unit="1"/>
+    <field id="frac_snow_nobio" name="frac_snow_nobio" long_name="Snow fraction on nobio area" unit="1" grid_ref="grid_nnobio"/>
+    <field id="vegetfrac" name="vegetfrac" long_name="Fraction of vegetation" unit="1" grid_ref="grid_nvm"/>
+    <field id="maxvegetfrac" name="maxvegetfrac" long_name="Maximum fraction of vegetation" unit="1" grid_ref="grid_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"  freq_offset="0ts"/>
+    <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" freq_offset="0ts"/>
+    <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" grid_ref="grid_nnobio"/>
+    <field id="frac_bare" name="frac_bare" long_name="Bare soil fraction for each PFT" unit="1" grid_ref="grid_nvm"/>
+    <field id="soiltile" name="soiltile" long_name="Fraction of soil tiles" unit="%" grid_ref="grid_nstm" operation="once" freq_offset="0ts"/>
+    <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="humtot_frozen" name="humtot_frozen" long_name="Total frozen soil moisture" unit="kg/m^2"/>
+    <field id="humtot_liquid" name="humtot_liquid" long_name="Total liquid soil moisture" unit="kg/m^2"> humtot-humtot_frozen </field>
+    <field id="tmc" name="humtot_soil" long_name="Soil Moisture for soil tiles" unit="Kg/m^2" grid_ref="grid_nstm"/>
+    <field id="rstruct" name="rstruct" long_name="Structural resistance" unit="s/m" grid_ref="grid_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" grid_ref="grid_nvm"/>
+    <field id="gpp_ipcc2" name="gpp_ipcc2" long_name="Net assimilation of carbon by the vegetation" unit="kgC/m^2/s" > this/1000 </field>
+    <field id="gppgrass" name="gppGrass" long_name="Gross Primary Production on grass tiles" unit="kgC/m^2/s" > this/1000 </field>
+    <field id="gppcrop" name="gppCrop" long_name="Gross Primary Production on crop tiles" unit="kgC/m^2/s" > this/1000 </field>
+    <field id="gpptree" name="gppTree" long_name="Gross Primary Production on tree tiles" unit="kgC/m^2/s" > this/1000 </field>
+    <field id="nee" name="nee" long_name="Net Ecosystem Exchange" unit="gC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="maint_resp" name="maint_resp" long_name="Maintenance respiration per PFT" unit="gC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="hetero_resp" name="hetero_resp" long_name="Heterotrophic respiration per PFT" unit="gC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="growth_resp" name="growth_resp" long_name="Growth respiration per PFT" unit="gC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="rh_ipcc2" name="rh_ipcc2" long_name="Heterotrophic respiration" unit="kgC/m^2/s"  > this/1000 </field>
+    <field id="rhGrass" name="rhGrass" long_name="Heterotrophic respiration on grass tiles" unit="kgC/m^2/s"  > this/1000 </field>
+    <field id="rhCrop" name="rhCrop" long_name="Heterotrophic respiration on crop tiles" unit="kgC/m^2/s"  > this/1000 </field>
+    <field id="rhTree" name="rhTree" long_name="Heterotrophic respiration on tree tiles" unit="kgC/m^2/s"  > this/1000 </field>
+    <field id="precisol" name="precisol" long_name="Throughfall+Totmelt per PFT" unit="mm/d" grid_ref="grid_nvm" > this*86400 </field>
+    <field id="throughfall" name="throughfall" long_name="Throughfall per PFT" unit="mm/d" grid_ref="grid_nvm" > this*86400 </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="dtes" name="dtes" long_name="Change of thermal energy content of surface for which the energy balance is calculated" unit="J/m2"/>
+    <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" grid_ref="grid_nvm"/>
+    <field id="humrel" name="humrel" long_name="Soil moisture stress for transpiration (it is not the relative humidity)" unit="1" grid_ref="grid_nvm"/>
+    <field id="cimean" name="cimean" long_name="Stomatal CO2 concentation" unit="mmole/m2/s" grid_ref="grid_nvm"/>
+    <field id="vbeta3" name="vbeta3" long_name="Beta for Transpiration" unit="1" grid_ref="grid_nvm"/>
+    <field id="rveget" name="rveget" long_name="Canopy resistance" unit="s/m" grid_ref="grid_nvm"/>
+    <field id="vbeta2" name="vbeta2" long_name="Beta for Interception loss" unit="1" grid_ref="grid_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" grid_ref="grid_nvm"/>
+    <field id="qsintmax" name="qsintmax" long_name="Maximum Interception capacity per PFT" unit="Kg/m^2" grid_ref="grid_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 and sublimation" 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="treeFracNdlEvg" name="treeFracNdlEvg" long_name="Fraction for needleleaf evergreen trees" unit="%"/>
+    <field id="treeFracBdlEvg" name="treeFracBdlEvg" long_name="Fraction for broadleaf evergreen trees" unit="%"/>
+    <field id="treeFracNdlDcd" name="treeFracNdlDcd" long_name="Fraction for needleleaf deciduous trees" unit="%"/>
+    <field id="treeFracBdlDcd" name="treeFracBdlDcd" long_name="Fraction for broadleaf deciduous trees" unit="%"/>
+    <field id="grassFracC3" name="grassFracC3" long_name="C3 Grass Fraction" unit="%"/>
+    <field id="grassFracC4" name="grassFracC4" long_name="C4 Grass Fraction" unit="%"/>
+    <field id="grassFrac" name="grassFrac" long_name="Total Grass Fraction" unit="%"> grassFracC3+grassFracC4 </field>
+    <field id="cropFracC3" name="cropFracC3" long_name="C3 Crop Fraction" unit="%"/>
+    <field id="cropFracC4" name="cropFracC4" long_name="C4 Crop Fraction" unit="%"/>
+    <field id="cropFrac" name="cropFrac" long_name="Total Crop Fraction" unit="%"> cropFracC3+cropFracC4 </field>
+    <field id="vegFrac" name="vegFrac" long_name="Total vegetated fraction" unit="%"> treeFrac+grassFrac+cropFrac </field>
+    <field id="baresoilFrac" name="baresoilFrac" long_name="Fraction of entire grid cell covered by bare soil PFT(pft=1)" unit="%"/>
+    <field id="residualFrac" name="residualFrac" long_name="Fraction of entire grid cell that is land but neither vegetation-covered nor bare soil (nobio)" 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" grid_ref="grid_nvm"/>
+    <field id="PARsh" name="PARsh" long_name="PAR received by shaded leaves" unit="umol phot/m^2/s" grid_ref="grid_nvm"/>
+    <field id="laisun" name="laisun" long_name="Sunlit Leaf Area Index" unit="1" grid_ref="grid_nvm"/>
+    <field id="laish" name="laish" long_name="Shaded Leaf Area Index" unit="1" grid_ref="grid_nvm"/>
+    <field id="PARsuntab" name="PARsuntab" long_name="PAR received by sun leaves over LAI layers" unit="umol phot/m^2/s" grid_ref="grid_nlaip1"/>
+    <field id="PARshtab" name="PARshtab" long_name="PAR received by shaded leaves over LAI layers" unit="umol phot/m^2/s" grid_ref="grid_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" grid_ref="grid_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" freq_offset="0ts"/>
+    <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" freq_offset="0ts"/>
+    <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" freq_offset="0ts"/>
+    <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" freq_offset="0ts"/>
+    <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" freq_offset="0ts"/>
+    <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" freq_offset="0ts"/>
+    <field id="flx_iso" name="flx_iso" long_name="Isoprene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="flx_mono" name="flx_mono" long_name="Monoterpene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="flx_ORVOC" name="flx_ORVOC" long_name="Other Volatile Organic Compound emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_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" grid_ref="grid_nvm"/>
+    <field id="flx_methanol" name="flx_methanol" long_name="Methanol emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="flx_acetone" name="flx_acetone" long_name="Acetone emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="flx_acetal" name="flx_acetal" long_name="Acetaldehyde emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="flx_formal" name="flx_formal" long_name="Formaldehyde emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="flx_acetic" name="flx_acetic" long_name="Acetic acid emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="flx_formic" name="flx_formic" long_name="Formic acid emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm"/>
+    <field id="flx_apinen" name="flx_apinen" long_name="Alpha pinene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_bpinen" name="flx_bpinen" long_name="Beta pinene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_limonen" name="flx_limonen" long_name="Limonene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_myrcen" name="flx_myrcen" long_name="Myrcene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_sabinen" name="flx_sabinen" long_name="Sabinene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_camphen" name="flx_camphen" long_name="Camphene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_3caren" name="flx_3caren" long_name="3-Carene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_tbocimen" name="flx_tbocimen" long_name="T-beta Ocimene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_othermono" name="flx_othermono" long_name="Emissions of other monoterpenes from vegetation" unit="kgC/m^2/s" grid_ref="grid_nvm" />
+    <field id="flx_sesquiter" name="flx_sesquiter" long_name="Sesquiterpene emissions from vegetation" unit="kgC/m^2/s" grid_ref="grid_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" grid_ref="grid_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" grid_ref="grid_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" grid_ref="grid_nvm"/>
+    <field id="fco2" name="fco2" long_name="Function for CO2 impact on BVOC (isoprene)" unit="1" grid_ref="grid_nvm" />
+    <field id="cim" name="cim" long_name="Intercellular CO2 over nlai" unit="ppm" grid_ref="grid_nvm" enabled=".FALSE." />
+    <field id="pb" name="Psurf" long_name="Surface pressure" unit="Pa" > this*100.0 </field>
+    <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 (mean over the area covered by PFTs, incl. PFT=1)" unit="1"/>
+    <field id="mcs" name="SoilSat" long_name="Mean volumetric water content at saturation" unit="m^3/m^3" grid_ref="grid_nslm" operation="once"  freq_offset="0ts"/>
+    <field id="nroot" name="RootDist" long_name="Cumulative root density (grid-cell average)" unit="1"  grid_ref="grid_nslm" operation="once"  freq_offset="0ts"/>
+    <field id="dlh" name="SoilThick" long_name="Hydrological soil layer thickness" unit="m"  grid_ref="grid_nslm" operation="once" freq_offset="0ts"/>
+    <field id="water2infilt" name="water2infilt" long_name="Storage of surface runoff kept for future infiltration(already included in humtot)" unit="Kg/m^2" grid_ref="grid_nstm"/>  
+    <field id="pkappa" name="pkappa" long_name="Soil thermal conductivity" unit="W/m/K" grid_ref="grid_ngrnd"/>  
+    <field id="pkappa_snow" name="pkappa_snow" long_name="Snow thermal conductivity" unit="W/m/K" grid_ref="grid_nsnow"/>  
+    <field id="pcapa" name="pcapa" long_name="Volumetric soil heat capacity" unit="J/m^3/K" grid_ref="grid_ngrnd"/>   
+    <field id="pcapa_spec" name="pcapa_spec" long_name="Specific soil heat capacity" unit="J/kg/K" grid_ref="grid_ngrnd"/>  
+    <field id="pcapa_snow" name="pcapa_snow" long_name="Snow heat capacity" unit="J/m^3/K" grid_ref="grid_nsnow"/>  
+    <field id="snowtemp" name="snowtemp" long_name="snow temperature" unit="K" grid_ref="grid_nsnow"/>  
+    <field id="snowtemp_weighted" name="snowtemp_weighted" long_name="mean snow temperature weighted by snow density" unit="K"/>  
+    <field id="snowliq" name="snowliq" long_name="Snow liquid content where land" unit="kg/m^2" grid_ref="grid_nsnow"/>  
+    <field id="snowliqtot" name="snowliqtot" long_name="Snow liquid content integrated over snow depth where land" unit="kg/m^2"/>  
+    <field id="snowdz" name="snowdz" long_name="Snow layer thickness in the snow fraction" unit="m" grid_ref="grid_nsnow"/>  
+    <field id="snowdepth" name="snowdepth" long_name="Total snow thickness (averaging over the entire land portion, including the snow-free fraction)" unit="m"/>  
+    <field id="snowrho" name="snowrho" long_name="Snow denisty" unit="Kg/m^3" grid_ref="grid_nsnow"/>  
+    <field id="snowheat" name="snowheat" long_name="Snow heat content" unit="J/m^2" grid_ref="grid_nsnow"/>  
+    <field id="del_snowheattot" name="del_snowheattot" long_name="Variation of Snow heat content integrated over snow depth" unit="J/m^2"/>  
+    <field id="snowgrain" name="snowgrain" long_name="Snow grain size" unit="m" grid_ref="grid_nsnow"/>  
+    <field id="snowflxtot" name="snowflxtot" long_name="Total snow flux (including snow on vegetated and bare soil and nobio areas)" unit="W/m^2"/>
+
+    <!-- Routing -->
+    <field id="basinmap" name="basinmap" long_name="Aproximate map of the river basins" operation="once" freq_offset="0ts"/>
+    <field id="nbrivers" name="nbrivers" long_name="Number or rivers in the outflow grid box" operation="once" freq_offset="0ts"/>
+    <field id="swampmap" name="swampmap" long_name="Map of swamp areas" unit="m^2" operation="once" freq_offset="0ts"/>
+    <field id="irrigmap" name="irrigmap" long_name="Map of irrigated areas" unit="m^2" operation="once" freq_offset="0ts"/>
+    <field id="floodmap" name="floodmap" long_name="Map of floodplains areas" unit="m^2" operation="once" freq_offset="0ts"/>
+    <field id="mask_coast" name="mask_coast" long_name="Mask of coastal gridcell which can recieve coastalflow" unit="" operation="once" freq_offset="0ts"/>
+    <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="SurfStor" name="SurfStor" long_name="Surface water Storage" unit="Kg/m^2"> laker+pondr+floodr </field>
+    <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_daily" name="delstock_routing_daily" long_name="Mean of storage change in all routing reservoirs accumulated each day" unit="kg/m^2/d"> delstreamr_daily + delfastr_daily + delslowr_daily + delfloodr_daily + delpondr_daily + dellaker_daily </field> 
+    <field id="delriv" name="delriv" long_name="Change in River Storage (sum of stream and fast reservoirs)" unit="kg/m^2"> delstreamr + delfastr </field> 
+    <field id="delsurfwater" name="delsurfwater" long_name="Change in surface water storage (sum of stream, fast, floodplains, lakes and ponds reservoirs)" unit="kg/m^2"> delstreamr + delfastr + delfloodr + dellaker + delpondr </field> 
+    <field id="surfwater" name="surfwater" long_name="Surface water storage (sum of stream, fast, floodplains, lakes and ponds reservoirs)" unit="kg/m^2"> streamr + fastr + floodr + laker + pondr </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="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="soilmoist" name="SoilMoist" long_name="3D average layer soil moisture" unit="kg/m^2" grid_ref="grid_nslm"/>
+    <field id="soilmoist_liquid" name="SoilMoistLiquid" long_name="3D average layer liquid soil moisture" unit="kg/m^2" grid_ref="grid_nslm"/>
+    <field id="soilmoist_frozen" name="SoilMoistFrozen" long_name="3D average layer frozen soil moisture" unit="kg/m^2" grid_ref="grid_nslm"> soilmoist-soilmoist_liquid </field>
+    <field id="soilwet" name="SoilWet" long_name="Total soil wetness" unit="1"/>
+    <field id="mrsow" name="mrsow" long_name="Total soil wetness above wilting point" 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="vevapflo" name="vevapflo" 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" grid_ref="grid_nslm"/>
+    <field id="kk_moy" name="kk_moy" long_name="Mean hydraulic conductivity over soiltiles" unit="10^(-6) m/s" grid_ref="grid_nslm" > this*1000/86400 </field>
+    <field id="psi_moy" name="psi_moy" long_name="Mean soil pressure head over soiltiles" unit="m" grid_ref="grid_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" grid_ref="grid_nslm"/>
+    <field id="profil_liquid_hydro" name="profil_liquid_hydro" long_name="Liquid fraction for each hydrological soil layer average over soil types" unit="1" grid_ref="grid_nslm"> 1.-profil_froz_hydro </field>
+    <field id="snowdz_read_prev" name="snowdz_read_prev" long_name="snowdz read from file, value from previous day" unit="m" grid_ref="grid_nsnow"/>
+    <field id="snowdz_read_current" long_name="" unit="m" grid_ref="grid_nsnow"/>
+    <field id="snowdz_read_next" long_name="" unit="m" grid_ref="grid_nsnow"/>
+    <field id="snowrho_read_prev" long_name="snowrho read from file, value from previous day" unit="kg/m^3" grid_ref="grid_nsnow"/>
+    <field id="snowrho_read_current" long_name="" unit="kg/m^3" grid_ref="grid_nsnow"/>
+    <field id="snowrho_read_next" long_name="" unit="kg/m^3" grid_ref="grid_nsnow"/>
+    <field id="snowtemp_read_prev" long_name="snowtemp read from file, value from previous day" unit="K" grid_ref="grid_nsnow"/>
+    <field id="snowtemp_read_current" long_name="" unit="K" grid_ref="grid_nsnow"/>
+    <field id="snowtemp_read_next" long_name="" unit="K" grid_ref="grid_nsnow"/>
+    <field id="mask_snow_interp_out" long_name="Mask read from file" operation="once" unit="1" grid_ref="grid_nsnow" freq_offset="0ts"/>
+    <field id="nudgincsm" name="nudgincsm" long_name="Nudging increment of water in soil moisture" unit="Kg/m^2"/>
+    <field id="nudgincswe" name="nudgincswe" long_name="Nudging increment of water in snow" unit="kg/m^2"/>
+    <field id="cnc" name="cnc" long_name="Canopy covered area percentage (fraction of total land)" unit="%"/> 
+    <field id="mcfc" name="mcfc" long_name="Mean volumetric water content at field capacity (total land average)" unit="m^3/m^3" grid_ref="grid_nslm" operation="once" freq_offset="0ts"/>
+    <field id="mcw" name="mcw" long_name="Mean volumetric water content at wilting point (total land average)" unit="m^3/m^3" grid_ref="grid_nslm" operation="once" freq_offset="0ts"/>
+    <field id="mcr" name="mcr" long_name="Mean volumetric residual water content (total land average)" unit="m^3/m^3" grid_ref="grid_nslm" operation="once" freq_offset="0ts"/>
+    <field id="tmcs" name="tmcs" long_name="Total soil moisture at saturation (total land average)" unit="kg/m^2" operation="once" freq_offset="0ts"/>
+    <field id="tmcfc" name="tmcfc" long_name="Total soil moisture at field capacity (total land average)" unit="kg/m^2" operation="once" freq_offset="0ts"/>
+    <field id="wilt" name="wilt" long_name="Wilting point (in % of soil volume)" unit="%" grid_ref="grid_nslm" operation="once" > mcw*100 </field>  
+    <field id="fldcapacity" name="fldcapacity" long_name="Field capacity (in % of soil volume)" grid_ref="grid_nslm" unit="%" operation="once" > mcfc*100 </field>
+    <field id="ksat" name="ksat" long_name="Saturated Hydraulic conductivity (at each hydrologic node)" unit="10^(-6) m/s" grid_ref="grid_nslm" operation="once" freq_offset="0ts"> this*1000/86400 </field> <!-- ym check this value. jg why ?  -->
+    <field id="alphavg" name="alphavg" long_name="Van Genuchten alpha parameter (at each hydrologic node)" unit="m(-1)" grid_ref="grid_nslm" operation="once" freq_offset="0ts"/> 
+    <field id="nvg" name="nvg" long_name="Van Genuchten n parameter (at each hydrologic node)" unit="-" grid_ref="grid_nslm" operation="once" freq_offset="0ts"/>
+
+    <field id="fraclut" name="fracLut" long_name="fraction of grid cell for each land use tile"  unit="%" grid_ref="grid_nlut"> this*100 </field>
+    <field id="nwdFraclut" name="nwdFraclut" long_name="fraction of land use tile that is non-woody vegetation"  unit="1" grid_ref="grid_nlut"/>
+    <field id="humtot_lut" name="mrsoLut" long_name="Total soil moisture" unit="kg m-2" grid_ref="grid_nlut" />
+    <field id="humtot_top_lut" name="mrsosLut" long_name="Moisture in Upper Portion of Soil Column of land use tile" unit="kg m-2" grid_ref="grid_nlut"/>
+    <field id="mrro_lut" name="mrroLut" long_name="Total runoff from land use tile" unit="kg m-2 s-1" grid_ref="grid_nlut"/>
+    <field id="gpplut" name="gppLut" long_name="Gross primary productivity on Landuse tiles" unit="kgC m-2 s-1" grid_ref="grid_nlut" />
+  </field_group>
+
+
+  <!-- ========================================================================================================= -->
+  <!-- Definition of output variables in stomate                                                                 -->
+  <!-- ========================================================================================================= -->
+
+  <field_group id="stomate" grid_ref="grid_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="-" grid_ref="grid_nvm"/>
+    <field id="ONSET_DATE" name="ONSET_DATE" long_name="The day in the year when leaves start to grow" unit="days" grid_ref="grid_nvm"/>
+    <field id="FPC_MAX" name="FPC_MAX" long_name="Foliage projective cover" unit="-" grid_ref="grid_nvm"/>
+    <field id="MAXFPC_LASTYEAR" name="MAXFPC_LASTYEAR" long_name="Foliage projective cover of last year" unit="-" grid_ref="grid_nvm"/>
+    <field id="HET_RESP" name="HET_RESP" long_name="heterotr. resp. from ground" unit="gC/m^2 tot/pft/day" grid_ref="grid_nvm"/>
+    <field id="firefrac" name="FIREFRAC" long_name="Fire fraction on ground " unit="1/day" grid_ref="grid_nvm"/>
+    <field id="CO2_FIRE" name="CO2_FIRE" long_name="Output CO2 flux from fire " unit="gC/day/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="CO2_TAKEN" name="CO2_TAKEN" long_name="CO2 taken from atmosphere for initiate growth " unit="gC/day/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="LAI" name="LAI" long_name="Leaf Area Index per PFT" unit="-" grid_ref="grid_nvm"/>
+    <field id="VEGET_COV_MAX" name="VEGET_COV_MAX" long_name="Maximum vegetation fraction (LAI -&gt; infinity) " unit="-" grid_ref="grid_nvm"/>
+    <field id="NPP_STOMATE" name="NPP" long_name="Net primary productivity (positive from atm to land)" unit="gC/day/(m^2 tot)" grid_ref="grid_nvm"/>
+    <field id="GPP" name="GPP" long_name="Gross primary productivity (positive from atm to land)" unit="gC/day/m^2" grid_ref="grid_nvm"/>
+    <field id="LEAF_M" name="LEAF_M" long_name="Leaf mass" unit="gC/m^2 " grid_ref="grid_nvm"/>
+    <field id="SAP_M_AB" name="SAP_M_AB" long_name="Sap mass above ground" unit="gC/m^2" grid_ref="grid_nvm"/>
+    <field id="SAP_M_BE" name="SAP_M_BE" long_name="Sap mass below ground" unit="gC/m^2" grid_ref="grid_nvm"/>
+    <field id="HEART_M_AB" name="HEART_M_AB" long_name="Heartwood mass above ground" unit="gC/m^2" grid_ref="grid_nvm"/>
+    <field id="HEART_M_BE" name="HEART_M_BE" long_name="Heartwood mass below ground" unit="gC/m^2" grid_ref="grid_nvm"/>
+    <field id="ROOT_M" name="ROOT_M" long_name="Root mass" unit="gC/m^2" grid_ref="grid_nvm"/>
+    <field id="FRUIT_M" name="FRUIT_M" long_name="Fruit mass" unit="gC/m^2" grid_ref="grid_nvm"/>
+    <field id="RESERVE_M" name="RESERVE_M" long_name="Carbohydrate reserve mass" unit="gC/m^2" grid_ref="grid_nvm"/>
+    <field id="MAINT_RESP" name="MAINT_RESP" long_name="Maintenance respiration" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="GROWTH_RESP" name="GROWTH_RESP" long_name="Growth respiration" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="IND" name="IND" long_name="Density of individuals" unit="1/ m^2" grid_ref="grid_nvm"/>
+    <field id="ADAPTATION" name="ADAPTATION" long_name="Adaptation to climate (DGVM)" unit="-" grid_ref="grid_nvm"/>
+    <field id="REGENERATION" name="REGENERATION" long_name="Probability from regenerative (DGVM)" unit="-" grid_ref="grid_nvm"/>
+    <field id="CN_IND" name="CN_IND" long_name="crown area of individuals" unit="m^2" grid_ref="grid_nvm"/>
+    <field id="WOODMASS_IND" name="WOODMASS_IND" long_name="Woodmass of individuals" unit="gC/pft" grid_ref="grid_nvm"/>
+    <field id="TOTAL_M" name="TOTAL_M" long_name="Total living biomass" unit="gC/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="MOISTRESS" name="MOISTRESS" long_name="weekly moisture stress" unit="-" grid_ref="grid_nvm"/>
+    <field id="TOTAL_TURN" name="TOTAL_TURN" long_name="total turnover rate" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN" name="LEAF_TURN" long_name="Leaf turnover" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <!--liulya LEAF TURN CL1-4-->
+    <field id="LEAF_TURN_CL1" name="LEAF_TURN_CL1" long_name="Leaf turnover for leaf age class 1" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN_CL2" name="LEAF_TURN_CL2" long_name="Leaf turnover for leaf age class 2" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN_CL3" name="LEAF_TURN_CL3" long_name="Leaf turnover for leaf age class 3" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN_CL4" name="LEAF_TURN_CL4" long_name="Leaf turnover for leaf age class 4" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN_CL4" name="LEAF_TURN_CL4" long_name="Leaf turnover for leaf age class 4" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN_Total_lly" name="LEAF_TURN_Total_lly" long_name="sum of Leaf turnover for leaf age class 1 to 4, should eq LEAF_TURN" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="LEAF_BM_CL1" name="LEAF_BM_CL1" long_name="Leaf Biomass for leaf age class 1" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="LEAF_BM_CL2" name="LEAF_BM_CL2" long_name="Leaf Biomass for leaf age class 2" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="LEAF_BM_CL3" name="LEAF_BM_CL3" long_name="Leaf Biomass for leaf age class 3" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="LEAF_BM_CL4" name="LEAF_BM_CL4" long_name="Leaf Biomass for leaf age class 4" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <!-- liulya 20220220 -->
+    <field id="LEAF_TURN_RATE_CL1" name="LEAF_TURN_RATE_CL1" long_name="Leaf turnover rate for leaf age class 1" unit="1" grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN_RATE_CL2" name="LEAF_TURN_RATE_CL2" long_name="Leaf turnover rate for leaf age class 2" unit="1" grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN_RATE_CL3" name="LEAF_TURN_RATE_CL3" long_name="Leaf turnover rate for leaf age class 3" unit="1" grid_ref="grid_nvm"/>
+    <field id="LEAF_TURN_RATE_CL4" name="LEAF_TURN_RATE_CL4" long_name="Leaf turnover rate for leaf age class 4" unit="1" grid_ref="grid_nvm"/>
+    <field id="LEAF_Frac_CL1" name="LEAF_Frac_CL1" long_name="Leaf fraction of leaf age class 1" unit="1" grid_ref="grid_nvm"/>
+    <field id="LEAF_Frac_CL2" name="LEAF_Frac_CL2" long_name="Leaf fraction of leaf age class 2" unit="1" grid_ref="grid_nvm"/>
+    <field id="LEAF_Frac_CL3" name="LEAF_Frac_CL3" long_name="Leaf fraction of leaf age class 3" unit="1" grid_ref="grid_nvm"/>
+    <field id="LEAF_Frac_CL4" name="LEAF_Frac_CL4" long_name="Leaf fraction of leaf age class 4" unit="1" grid_ref="grid_nvm"/>
+    <!--liulya above-->
+    <field id="SAP_AB_TURN" name="SAP_AB_TURN" long_name="Sap turnover above" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="ROOT_TURN" name="ROOT_TURN" long_name="Root turnover" unit="gC/m^2/day " grid_ref="grid_nvm"/>
+    <field id="FRUIT_TURN" name="FRUIT_TURN" long_name="Fruit turnover" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="TOTAL_BM_LITTER" name="TOTAL_BM_LITTER" long_name="total conversion of biomass to litter" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <!--liulyc total litterfall add by lyliu-->
+    <field id="TOTAL_LITTERFALL" name="TOTAL_LITTERFALL" long_name="Total litterfall add by lyliu" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="LEAF_BM_LITTER" name="LEAF_BM_LITTER" long_name="Leaf death" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="SAP_AB_BM_LITTER" name="SAP_AB_BM_LITTER" long_name="Sap death above ground" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="SAP_BE_BM_LITTER" name="SAP_BE_BM_LITTER" long_name="Sap death below ground" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="HEART_AB_BM_LITTER" name="HEART_AB_BM_LITTER" long_name="Heartwood death above ground" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="HEART_BE_BM_LITTER" name="HEART_BE_BM_LITTER" long_name="Heartwood death below ground" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="ROOT_BM_LITTER" name="ROOT_BM_LITTER" long_name="Root death" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="FRUIT_BM_LITTER" name="FRUIT_BM_LITTER" long_name="Fruit death" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="RESERVE_BM_LITTER" name="RESERVE_BM_LITTER" long_name="Carbohydrate reserve death" unit="gC/m^2/day" grid_ref="grid_nvm"/>
+    <field id="LITTER_STR_AB" name="LITTER_STR_AB" long_name="structural litter above ground" unit="gC/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="LITTER_MET_AB" name="LITTER_MET_AB" long_name="metabolic litter above ground" unit="gC/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="LITTER_STR_BE" name="LITTER_STR_BE" long_name="structural litter below ground" unit="gC/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="LITTER_MET_BE" name="LITTER_MET_BE" long_name="metabolic litter below ground" unit="gC/m^2/pft" grid_ref="grid_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" grid_ref="grid_nvm"/>
+    <field id="CARBON_ACTIVE" name="CARBON_ACTIVE" long_name="active soil carbon in ground " unit="gC/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="CARBON_SLOW" name="CARBON_SLOW" long_name="slow soil carbon in ground" unit="gC/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="CARBON_PASSIVE" name="CARBON_PASSIVE" long_name="passive soil carbon in ground" unit="gC/m^2/pft" grid_ref="grid_nvm"/>
+    <field id="LITTERHUM" name="LITTERHUM" long_name="Litter humidity" unit="-"/>
+    <field id="BM_ALLOC_LEAF" name="BM_ALLOC_LEAF" long_name="biomass allocated to leaves" unit="gC/m**2/pft/dt" grid_ref="grid_nvm"/>
+    <field id="BM_ALLOC_SAP_AB" name="BM_ALLOC_SAP_AB" long_name="biomass allocated to sapwood above ground" unit="gC/m**2/pft/dt" grid_ref="grid_nvm"/>
+    <field id="BM_ALLOC_SAP_BE" name="BM_ALLOC_SAP_BE" long_name="biomass allocated to sapwood below ground" unit="gC/m**2/pft/dt" grid_ref="grid_nvm"/>
+    <field id="BM_ALLOC_ROOT" name="BM_ALLOC_ROOT" long_name="biomass allocated to roots" unit="gC/m**2/pft/dt" grid_ref="grid_nvm"/>
+    <field id="BM_ALLOC_FRUIT" name="BM_ALLOC_FRUIT" long_name="biomass allocated to fruits" unit="gC/m**2/pft/dt" grid_ref="grid_nvm"/>
+    <field id="BM_ALLOC_RES" name="BM_ALLOC_RES" long_name="biomass allocated to carbohydrate reserve" unit="gC/m**2/pft/dt" grid_ref="grid_nvm"/>
+    <field id="HERBIVORES" name="HERBIVORES" long_name="time constant of herbivore activity" unit="days" grid_ref="grid_nvm"/>
+    <field id="TURNOVER_TIME" name="TURNOVER_TIME" long_name="turnover time for grass leaves" unit="days" grid_ref="grid_nvm"/>
+    <field id="PROD10" name="PROD10" long_name="10 year wood product pool" unit="gC/m**2" grid_ref="grid_P11"/>
+    <field id="FLUX10" name="FLUX10" long_name="annual flux for each 10 year wood product pool" unit="gC/m**2/yr" grid_ref="grid_P10"/>
+    <field id="PROD100" name="PROD100" long_name="100 year wood product pool" unit="gC/m**2" grid_ref="grid_P101"/>
+    <field id="FLUX100" name="FLUX100" long_name="annual flux for each 100 year wood product pool" unit="gC/m**2/yr" grid_ref="grid_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="fDeforestToProduct_post" name="fDeforestToProduct_post" long_name="Decomposition out of product pools to CO2 (positive from land to atm) calculated as postprocessing" unit="gC/m**2/day"  > -1*(CONVFLUX+CFLUX_PROD10+CFLUX_PROD100) </field>
+    <field id="fDeforestToProduct" name="fDeforestToProduct" long_name="Decomposition out of product pools to CO2 (positive from land to atm)" unit="kgC/m**2/s" />
+    <field id="PROD10_HARVEST" name="PROD10_HARVEST" long_name="10 year wood product pool" unit="gC/m**2" grid_ref="grid_P11"/>
+    <field id="FLUX10_HARVEST" name="FLUX10_HARVEST" long_name="annual flux for each 10 year wood product pool" unit="gC/m**2/yr" grid_ref="grid_P10"/>
+    <field id="PROD100_HARVEST" name="PROD100_HARVEST" long_name="100 year wood product pool" unit="gC/m**2" grid_ref="grid_P101"/>
+    <field id="FLUX100_HARVEST" name="FLUX100_HARVEST" long_name="annual flux for each 100 year wood product pool" unit="gC/m**2/yr" grid_ref="grid_P100"/>
+    <field id="CONVFLUX_HARVEST" name="CONVFLUX_HARVEST" long_name="annual release right after wood harvest (positive from atm to land)" unit="gC/m**2/day"/>
+    <field id="CFLUX_PROD10_HARVEST" name="CFLUX_PROD10_HARVEST" 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_HARVEST" name="CFLUX_PROD100_HARVEST" long_name="annual release from all 100 year wood product pools (positive from atm to land)" unit="gC/m**2/day"/>
+    <field id="WOOD_HARVEST" name="WOOD_HARVEST" long_name="harvested wood biomass as read in the map" unit="gC/m**2/day"/>
+    <field id="WOOD_HARVEST_PFT" name="WOOD_HARVEST_PFT" long_name="harvested wood biomass used per PFT" unit="gC/m**2/day" grid_ref="grid_nvm"/>
+    <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="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="-" grid_ref="grid_nvm"/>
+    <!--liuly-->
+    <field id="VCMAX_CL1" name="VCMAX_CL1" long_name="Maximum rate of carboxylation for leasf age class 1" unit="-" grid_ref="grid_nvm"/>
+    <field id="VCMAX_CL2" name="VCMAX_CL2" long_name="Maximum rate of carboxylation for leasf age class 2" unit="-" grid_ref="grid_nvm"/>
+    <field id="VCMAX_CL3" name="VCMAX_CL3" long_name="Maximum rate of carboxylation for leasf age class 3" unit="-" grid_ref="grid_nvm"/>
+    <field id="VCMAX_CL4" name="VCMAX_CL4" long_name="Maximum rate of carboxylation for leasf age class 4" unit="-" grid_ref="grid_nvm"/>
+    <field id="LEAF_AGE_CL1" name="LEAF_AGE_CL1" long_name="leaf age of class 1" unit="days" grid_ref="grid_nvm"/>
+    <field id="LEAF_AGE_CL2" name="LEAF_AGE_CL2" long_name="leaf age of class 2" unit="days" grid_ref="grid_nvm"/>
+    <field id="LEAF_AGE_CL3" name="LEAF_AGE_CL3" long_name="leaf age of class 3" unit="days" grid_ref="grid_nvm"/>
+    <field id="LEAF_AGE_CL4" name="LEAF_AGE_CL4" long_name="leaf age of class 4" unit="days" grid_ref="grid_nvm"/>
+    <!--liuly-->
+    <field id="LEAF_AGE" name="LEAF_AGE" long_name="leaf age" unit="days" grid_ref="grid_nvm"/>
+    <field id="mortality" name="MORTALITY" long_name="Fraction of trees that dies (gap)" unit="1/day" grid_ref="grid_nvm"/>
+    <field id="firedeath" name="FIREDEATH" long_name="Fraction of plants killed by fire" unit="1/day" grid_ref="grid_nvm"/>
+    <field id="IND_ESTAB" name="IND_ESTAB" long_name="Density of newly established saplings" unit="ind/m**2/day" grid_ref="grid_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" grid_ref="grid_nvm"/>
+    <field id="AGE" name="AGE" long_name="age" unit="years" grid_ref="grid_nvm"/>
+    <field id="HEIGHT" name="HEIGHT" long_name="height" unit="m" grid_ref="grid_nvm"/>
+    <field id="WHEN_GROWTHINIT" name="WHEN_GROWTHINIT" long_name="Time elapsed from season beginning" unit="d" grid_ref="grid_nvm"/>
+    <field id="PFTPRESENT" name="PFTPRESENT" long_name="PFT exists" unit="d" grid_ref="grid_nvm"/>
+    <field id="GDD_MIDWINTER" name="GDD_MIDWINTER" long_name="Growing degree days, since midwinter" unit="degK" grid_ref="grid_nvm"/>
+    <field id="GDD_M5_DORMANCE" name="GDD_M5_DORMANCE" long_name="Growing degree days threshold" unit="degK" grid_ref="grid_nvm"/>
+    <field id="NCD_DORMANCE" name="NCD_DORMANCE" long_name="Number of chilling days, since leaves were lost" unit="d" grid_ref="grid_nvm"/>
+    <field id="ALLOW_INITPHENO" name="ALLOW_INITPHENO" long_name="Allow to declare beginning of the growing season" unit="-" grid_ref="grid_nvm"/>
+    <field id="BEGIN_LEAVES" name="BEGIN_LEAVES" long_name="Signal to start putting leaves on" unit="-" grid_ref="grid_nvm"/>
+    <field id="t2m_longterm" name="T2M_LONGTERM" long_name="Longterm(3 years) 2 m temperature" unit="K"/>
+    <field id="FIREINDEX" name="FIREINDEX" long_name="Fire index on ground" unit="-" grid_ref="grid_nvm"/>
+    <field id="cVeg" name="cVeg" long_name="Carbon in Vegetation" unit="kg C m-2"/>
+    <field id="cVegGrass" name="cVegGrass" long_name="Carbon mass in Vegetation on grass tiles" unit="kg C m-2"/>
+    <field id="cVegCrop" name="cVegCrop" long_name="Carbon mass in Vegetation on crop tiles" unit="kg C m-2"/>
+    <field id="cVegTree" name="cVegTree" long_name="Carbon mass in Vegetation on tree tiles" unit="kg C m-2"/>
+    <field id="cLitter" name="cLitter" long_name="Carbon in Litter Pool" unit="kg C m-2"/>
+    <field id="cLitterGrass" name="cLitterGrass" long_name="Carbon mass in litter on grass tiles" unit="kg C m-2"/>
+    <field id="cLitterCrop" name="cLitterCrop" long_name="Carbon mass in litter on crop tiles" unit="kg C m-2"/>
+    <field id="cLitterTree" name="cLitterTree" long_name="Carbon mass in litter on tree tiles" unit="kg C m-2"/>
+    <field id="cOther" name="cOther" long_name="Carbon mass in vegetation components other than leaves, stems, and roots (fruits and reserves)" unit="kg C m-2"/>
+    <field id="cSoil" name="cSoil" long_name="Carbon in Soil Pool" unit="kg C m-2"/>
+    <field id="cSoilGrass" name="cSoilGrass" long_name="Carbon mass in soil on grass tiles" unit="kg C m-2"/>
+    <field id="cSoilCrop" name="cSoilCrop" long_name="Carbon mass in soil on crop tiles" unit="kg C m-2"/>
+    <field id="cSoilTree" name="cSoilTree" long_name="Carbon mass in soil on tree tiles" unit="kg C m-2"/>
+    <field id="cLand" name="cLand" long_name="Total carbon in all terrestrial carbon pools" unit="kg C m-2" > cVeg+cSoil </field>
+    <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="Mean Leaf Area Index (mean over the entire land 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="raGrass" name="raGrass" long_name="Autotrophic Respiration on grass tiles (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="raCrop" name="raCrop" long_name="Autotrophic Respiration on crop tiles (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="raTree" name="raTree" long_name="Autotrophic Respiration on tree tiles (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="rhSoil" name="rhSoil" long_name="Carbon mass flux due to heterotrophic respiration from soil on land (positive from land to atm)" unit="kg C m-2 s-1"  > this*(-1) </field>
+    <field id="rhLitter" name="rhLitter" long_name="Carbon mass flux due to heterotrophic respiration from litter on land (positive from land to atm)" unit="kg C m-2 s-1"  > this*(-1) </field>
+    <field id="tSoilPools" name="tSoilPools" long_name="soil_carbon_turnover_rate : defined as 1/(turnover time) for soil pools." unit="s-1" grid_ref="grid_ncarb"/>
+    <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="fWoodharvest" name="fWoodharvest" long_name="CO2 Flux to Atmosphere from Wood 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="fAnthDisturb" name="fAnthDisturb" long_name="Carbon mass flux into atmosphere due to any human activity" unit="kg C m-2 s-1"  > (fHarvest+fLuc+fWoodharvest)*(-1) </field>
+    <field id="fHarvestToProduct" name="fHarvestToProduct" long_name="" unit="kg C m-2 s-1"  > (fHarvest+fWoodharvest)*(-1) </field>
+    <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="cStem" name="cStem" long_name="Carbon in Stem (sapwood and hardwood above surface)" unit="kg C m-2"/>
+    <field id="cWood" name="cWood" long_name="Carbon in Wood (sapwood and hardwood above and below surface)" 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="cSoilPools" name="cSoilPools" long_name="Carbon in Soil Pools" unit="kg C m-2" grid_ref="grid_ncarb"/>
+    <field id="landCoverFrac" name="landCoverFrac" long_name="Fractional Land Cover of PFT" unit="%" grid_ref="grid_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="rGrowth_ipcc" name="rGrowth_ipcc" long_name="Growth Autotrophic Respiration (positive from land to atm)" unit="kg C m-2 s-1" > rGrowth*(-1) </field> 
+    <field id="rMaint_ipcc" name="rMaint_ipcc" long_name="Maintenance Autotrophic Respiration (positive from land to atm)" unit="kg C m-2 s-1" > rMaint*(-1) </field> 
+    <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 (above and below surface) (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nppStem" name="nppStem" long_name="CO2 Flux from Atmosphere due to NPP Allocation to Stem (above surface) (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="nppGrass" name="nppGrass" long_name="Net primary production on grass tiles (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nppCrop" name="nppCrop" long_name="Net primary production on crop tiles (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nppTree" name="nppTree" long_name="Net primary production on tree tiles (positive from atm to land)" unit="kg C m-2 s-1"/>
+    <field id="nppOther" name="nppOther" long_name="Net primary production allocated to other pools (fruit and reserve) (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 atm to land)" 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" grid_ref="grid_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="clitterlut" name="cLitterLut" long_name="Carbon in above and belowground litter pools on land use tiles" unit="kg C m-2" grid_ref="grid_nlut"/>
+    <field id="csoillut" name="cSoilLut" long_name="Carbon in soil pool on land use tiles"  unit="kg C m-2" grid_ref="grid_nlut"/>
+    <field id="cveglut" name="cvegLut" long_name="Carbon in vegetation on land use tiles"  unit="kg C m-2" grid_ref="grid_nlut"/>
+    <field id="lailut" name="laiLut" long_name="Leaf area index on Landuse tile"  unit="1" grid_ref="grid_nlut"/>
+    <field id="ctotfirelut" name="ctotfirelut" long_name=""  unit="kgC m-2 s-1" grid_ref="grid_nlut"/>
+    <field id="ralut" name="ralut" long_name="Plant respiration on land use tile"  unit="kgC m-2 s-1" grid_ref="grid_nlut"/>
+    <field id="rhlut" name="rhlut" long_name="Soil heterotrophic respiration on land use tile"  unit="kgC m-2 s-1" grid_ref="grid_nlut"/>
+    <field id="npplut" name="npplut" long_name="Net primary productivity on land use tile"  unit="kgC m-2 s-1" grid_ref="grid_nlut"/>
+    <field id="cproductlut" name="cproductLut" long_name="Carbon mass per unit area in that has been removed from the environment through land use change" unit="kgC m-2" grid_ref="grid_nlut" />
+    <field id="flulccproductlut" name="flulccproductlut" long_name="Carbon mass flux into wood and agricultural product pools due to anthropogenic land use or land cover change" unit="kgC m-2 s-1" grid_ref="grid_nlut" />
+    <field id="flulccresiduelut" name="flulccresiduelut" long_name="Carbon mass flux into soil and litter due to anthropogenic land use or land cover change" unit="kgC m-2 s-1" grid_ref="grid_nlut" />
+    <field id="flulccresidue" name="flulccresidue" long_name="Carbon mass flux into soil and litter due to anthropogenic land use or land cover change" unit="kgC m-2 s-1" grid_ref="grid_nvm" />
+    <field id="flulccatmlut" name="flulccatmlut" long_name="Surface upward mass flux of carbon dioxide expressed as carbon direct to atmosphere due to anthropogenic land use land cover change" unit="kgC m-2 s-1" grid_ref="grid_nlut" />
+    <field id="necbLut" name="necbLut" long_name="Surface net downward mass flux of carbon dioxide expressed as carbon due to all land processes" unit="kgC m-2 s-1" grid_ref="grid_nlut" > npplut - ralut - rhlut - flulccproductlut </field>
+    <field id="fProductDecomp" name="fProductDecomp" long_name="Decomposition out of Product Pools to CO2 in Atmosphere" unit="kgC m-2 s-1" > fLuc + fHarvest  </field>
+  </field_group>
+
+
+  <!-- ========================================================================================================= -->
+  <!-- Definition of output 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="mc_read_next" name="mc_read_next" long_name="Soil moisture read from file" unit="m3/m3" grid_ref="grid_nslm_nstm"/>
+  <field id="mc_read_current" name="mc_read_current" long_name="Soil moisture read from file and interpolated to current time step" unit="m3/m3" grid_ref="grid_nslm_nstm"/>
+  <field id="mc_read_prev" name="mc_read_prev" long_name="Soil moisture read from file, value from previous day" unit="m3/m3" grid_ref="grid_nslm_nstm"/>
+  <field id="mask_mc_interp_out" name="mask_mc_interp_out" long_name="Mask read from file" operation="once" unit="1" 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_definition>
Index: /branches/publications/ORCHIDEE-AFP/src_xml/file_def_orchidee.xml
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_xml/file_def_orchidee.xml	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_xml/file_def_orchidee.xml	(revision 8430)
@@ -0,0 +1,1041 @@
+<!-- =========================================================================================================== -->
+<!-- file_def_orchidee.xml : Definition of output files                                                          -->
+<!--                                                                                                             -->
+<!-- Definition of each output file and the list of variables they will include.                                 -->
+<!-- Change this file by adding the files and/or variables you want to write.                                    -->
+<!-- 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,-->
+<!-- output_level="1" for few variables, output_level="12" for writing all variables (depending on file).        -->
+<!--                                                                                                             -->
+<!-- Each file can have different output frequence, different variable content and different output_level.       --> 
+<!-- A file will contain all the variables listed in its section having level lower or equal to output_level     -->
+<!-- which is specified for the file.                                                                            -->
+<!--                                                                                                             -->
+<!-- All variables needed for the monitoring done by libIGCM are set to level="0". Set output_level=0 for file   -->
+<!-- sechiba_history, stomate_history and stomate_ipcc_history to output only these variables. These files       -->
+<!-- should have output_freq="1mo" for a correct monitoring except for SPINUP_ANALYTIC where the frequency       -->
+<!-- should be output_freq="1y".                                                                                 -->
+<!--                                                                                                             -->
+<!-- Key word compression_level activates the corresponding compresion level of netcd4/hdf5 where 0              -->
+<!-- corresponds to no compression and 4 is a middle compression here set as default.                            -->
+<!--                                                                                                             -->
+<!-- $HeadURL$               -->
+<!-- $Date$                                                      -->
+<!-- $Revision$                                                                                           -->
+<!-- =========================================================================================================== -->
+
+<file_definition type="one_file" par_access="collective" enabled=".TRUE." min_digits="4" compression_level="4" >
+
+  <!-- ========================================================================================================= -->
+  <!-- Definition of output files -->
+  <!-- ========================================================================================================= -->
+
+  <!-- Definition of output files with sechiba diagnostics -->
+
+  <!-- Sechiba file 1 -->
+  <file id="sechiba1" name="sechiba_history" output_level="_AUTO_" output_freq="_AUTO_" enabled="_AUTO_">
+
+  <field_group freq_op="1ts" grid_ref="grid_landpoints_out" group_ref="remap_expr">
+    <!-- lly modified-->
+    <field field_ref="TVeg" name="TVeg" long_name="Transpiration" unit="kg/m^2/s" level="0"/>  
+    <field field_ref="vevapp" name="evap_sec" long_name="Total Evaporation" unit="kg/m^2/s" level="0"/> 
+    <!-- <field field_ref="PAR" level="0"/> -->
+    <field field_ref="temp_air" name="Tair" level="0"/>
+    
+    <field field_ref="LtoLSR" level="0"/>                                          
+    <field field_ref="RtoLSR" level="0"/>                                       
+    <field field_ref="StoLSR" level="0"/> 
+    <field field_ref="oLtoLSR" level="0"/>                                          
+    <field field_ref="oRtoLSR" level="0"/>                                       
+    <field field_ref="oStoLSR" level="0"/> 
+
+    <field field_ref="gstot_lly" level="0"/> 
+    <field field_ref="VPD" level="0"/>       
+    <field field_ref="VPD_lly" level="0"/> 
+    <field field_ref="fVPD" level="0"/>    
+    <!--Below failed by xchen-->
+    <field field_ref="FAPAR" name="FAPAR_xc" grid_ref="grid_nvm_out" level="1"/>                                        
+    <field field_ref="PAR_xc" grid_ref="grid_nvm_out" level="1"/>                                       
+    <field field_ref="LUE" name="LUE_test" grid_ref="grid_nvm_out" level="1"/>                                          
+    <field field_ref="PC" grid_ref="grid_nvm_out" level="1"/> 
+    <field field_ref="PC_wu" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="PC_xc" grid_ref="grid_nvm_out" level="1"/>      
+    <field field_ref="Gc" grid_ref="grid_nvm_out" level="0"/>           
+    <field field_ref="Gs" grid_ref="grid_nvm_out" level="0"/>                                           
+    <field field_ref="GPP_CL1" name="GPP_CL1" grid_ref="grid_nvm_out" level="0"/>                       
+    <field field_ref="GPP_CL2" name="GPP_CL2" grid_ref="grid_nvm_out" level="0"/>                       
+    <field field_ref="GPP_CL3" name="GPP_CL3" grid_ref="grid_nvm_out" level="0"/>                       
+    <field field_ref="GPP_CL4" name="GPP_CL4" grid_ref="grid_nvm_out" level="0"/>                       
+    <field field_ref="GPP_xc" name="GPP_xc" grid_ref="grid_nvm_out" level="0"/> 
+
+    <!--liulye-->
+    <field field_ref="Turnover_rate_ori" level="0"/>
+    <field field_ref="Turnover_rate_vpd" level="0"/>
+    <field field_ref="Turnover_rate_sw" level="0"/>
+    <field field_ref="Turnover_rate_pre" level="0"/>
+    <field field_ref="Turnover_rate_final" level="0"/>
+    <field field_ref="Pre_weekly" level="0"/>
+    <field field_ref="SWdown_weekly" level="0"/>
+    <field field_ref="VPD_weekly" level="0"/>
+
+
+
+    <!-- lly modified from sechiba 4 dim
+    <field field_ref="mc" grid_ref="grid_nslm_nstm_out" level="1"/>
+    <field field_ref="mc_read_current" grid_ref="grid_nslm_nstm_out" level="1"/>
+    <field field_ref="kfact_root" grid_ref="grid_nslm_nstm_out" level="1"/>
+    <field field_ref="vegetmax_soil" grid_ref="grid_nvm_nstm_out" level="1"/>
+    <field field_ref="profil_froz_hydro_ns" grid_ref="grid_nslm_nstm_out" level="1"/> -->
+
+
+
+    <!-- level 1 -->
+    <field field_ref="areas" level="0"/>
+    <field field_ref="LandPoints" level="20"/>
+    <field field_ref="contfrac" level="0"/>
+    <field field_ref="vevapp_day" level="0"/>
+    <field field_ref="coastalflow" level="0"/>
+    <field field_ref="riverflow" level="0"/>
+    <field field_ref="coastalflow_cpl" level="1"/>
+    <field field_ref="riverflow_cpl" level="1"/>
+    <field field_ref="temp_sol_new_C" level="0"/>
+    <field field_ref="mrsow" level="1"/>
+    <field field_ref="ksat" grid_ref="grid_nslm_out" level="1"/>
+    <field field_ref="precip_rain" level="0" name="rain" unit="mm/d" > @precip_rain*86400  </field>
+    <field field_ref="precip_snow" level="0" name="snowf" unit="mm/d" > @precip_snow*86400  </field>
+    <field field_ref="netrad" level="1"/>
+    <field field_ref="lai" grid_ref="grid_nvm_out" level="0"/>
+    <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" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="wtd" level="1"/>
+    <field field_ref="tws" level="1"/>
+    <!-- level 2 -->
+    <field field_ref="vevapsno" name="subli" level="0" unit="mm/d" > @vevapsno*86400  </field>
+    <field field_ref="runoff" name="runoff" level="0" unit="mm/d" > @runoff*86400  </field>
+    <field field_ref="drainage" name="drainage" level="0" unit="mm/d" > @drainage*86400  </field>
+    <field field_ref="riversret" level="2"/>
+    <field field_ref="hydrographs" level="2"/>
+    <field field_ref="vevapnu" name="evapnu" level="0" unit="mm/d" > @vevapnu*86400  </field>
+    <field field_ref="evapnu_soil" grid_ref="grid_nstm_out" level="2"/>
+    <field field_ref="drainage_soil" grid_ref="grid_nstm_out" level="2"/>
+    <field field_ref="transpir_soil" grid_ref="grid_nstm_out" level="2"/>
+    <field field_ref="runoff_soil" grid_ref="grid_nstm_out" level="2"/>
+    <field field_ref="temp_air" level="0"/>
+    <field field_ref="qair" level="2"/>
+    <field field_ref="soilalb_bg" grid_ref="grid_albtyp_out" level="2"/>
+    <field field_ref="albedo_vis" level="0"/>
+    <field field_ref="albedo_nir" level="0"/>
+    <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" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="inter" grid_ref="grid_nvm_out" level="0"/>
+    <!-- for water budget control -->
+    <field field_ref="delsoilmoist_daily" level="0" />
+    <field field_ref="delintercept_daily" level="0" />
+    <field field_ref="delswe_daily" level="0" />
+    <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_daily" level="0" />
+    <field field_ref="vevapflo" name="evapflo" level="2" unit="mm/d" > @vevapflo*86400 </field>
+    <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="0"/>
+    <field field_ref="fluxlat" level="0"/>
+    <field field_ref="snow" level="0"/>
+    
+    <field field_ref="snowage" level="3"/>
+    <field field_ref="snownobio" grid_ref="grid_nnobio_out" level="0"/>
+    <field field_ref="snownobioage" grid_ref="grid_nnobio_out" level="3"/>
+    <field field_ref="vegetfrac" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="maxvegetfrac" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="tot_bare_soil" level="3"/>
+    <field field_ref="nobiofrac" grid_ref="grid_nnobio_out" level="0"/>
+    <field field_ref="reinfiltration" level="3"/>
+    <field field_ref="frac_bare" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="soiltile" grid_ref="grid_nstm_out" level="3"/>
+    <field field_ref="qflux" grid_ref="grid_nslm_out" 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="0"/>
+    <field field_ref="tmc" grid_ref="grid_nstm_out" level="4"/>
+    <field field_ref="qsintveg" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="rstruct" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="r_soil" level="4"/>
+    <!-- lly  -->
+    <field field_ref="gpp" grid_ref="grid_nvm_out" long_name="Net assimilation of carbon by the vegetation" unit="gC/m^2/s" level="0"/>
+    <field field_ref="gpp_ipcc2" level="4"/>
+    <field field_ref="gppgrass" level="4"/>
+    <field field_ref="gppcrop" level="4"/>
+    <field field_ref="gpptree" level="4"/>
+    <!-- lly  -->
+    <field field_ref="nee" grid_ref="grid_nvm_out" name="nee" long_name="Net Ecosystem Exchange" unit="gC/m^2/s" level="0"/>
+    <field field_ref="maint_resp" grid_ref="grid_nvm_out" name="maint_resp" long_name="Maintenance respiration per PFT" unit="gC/m^2/s" level="0"/>
+    <field field_ref="hetero_resp" grid_ref="grid_nvm_out" name="hetero_resp" long_name="Heterotrophic respiration per PFT" unit="gC/m^2/s" level="0"/>
+    <field field_ref="growth_resp" grid_ref="grid_nvm_out" name="growth_resp" long_name="Growth respiration per PFT" unit="gC/m^2/s" level="0"/>
+    <!-- lly above  -->
+
+    <field field_ref="rh_ipcc2" level="4"/>
+    <field field_ref="rhGrass" level="4"/>
+    <field field_ref="rhCrop" level="0"/>
+    <field field_ref="rhTree" level="4"/>
+    <field field_ref="precisol" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="throughfall" grid_ref="grid_nvm_out" 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="0"/>
+    <field field_ref="lwdown" level="0"/>
+    <field field_ref="lwnet" level="5"/>
+    <field field_ref="diffevap" level="5"/>
+    <field field_ref="temp_hydro" grid_ref="grid_nslm_out" 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="0"/>
+    <field field_ref="ptn" grid_ref="grid_ngrnd_out" 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="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" > @irrigation*86400  </field>
+    <field field_ref="netirrig" name="netirrig" level="8" unit="mm/d" > @netirrig*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" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="humrel" grid_ref="grid_nvm_out" level="0"/>
+    <!-- level 10 -->
+    <field field_ref="cimean" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="vbeta3" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="rveget" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="vbeta2" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="qsintmax" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="dtes" level="10"/>
+    <field field_ref="tairmax"  level="10"/>
+    <field field_ref="tasmax"  level="10"/>
+    <field field_ref="tairmin"  level="10"/>
+    <field field_ref="tasmin"  level="10"/>
+    <!-- level 11 -->
+    <!-- lly soil -->
+    <field field_ref="clayfraction" name="clayfraction" long_name="Fraction of clay particles in soil (grid-cell mean)" unit="1" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="sandfraction" name="sandfraction" long_name="Fraction of sand particles in soil (grid-cell mean)" unit="1" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="siltfraction" name="siltfraction" long_name="Fraction of silt particles in soil (grid-cell mean)" unit="1" grid_ref="grid_nslm_out" level="11"/>
+    <!-- lly soil -->
+    <field field_ref="humtot_top" level="0"/>
+    <field field_ref="humtot" name="mrso" level="0"/>
+    <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="vegFrac" level="11"/>
+    <field field_ref="treeFrac" level="11"/>
+    <field field_ref="treeFracNdlEvg" level="11"/>
+    <field field_ref="treeFracBdlEvg" level="11"/>
+    <field field_ref="treeFracNdlDcd" level="11"/>
+    <field field_ref="treeFracBdlDcd" level="11"/>
+    <field field_ref="grassFrac" level="11"/>
+    <field field_ref="grassFracC3" level="11"/>
+    <field field_ref="grassFracC4" level="11"/>
+    <field field_ref="cropFrac" level="11"/>
+    <field field_ref="cropFracC3" level="11"/>
+    <field field_ref="cropFracC4" level="11"/>
+    <field field_ref="baresoilFrac" level="11"/>
+    <field field_ref="residualFrac" level="11"/>
+    <!-- <field field_ref="PAR" level="11"/> -->
+    <!--move t above-->
+    <field field_ref="PARsun" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="PARsh" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="laisun" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="laish" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="PARsuntab" grid_ref="grid_nlaip1_out" level="0"/>
+    <field field_ref="PARshtab" grid_ref="grid_nlaip1_out" level="0"/>
+    <field field_ref="coszang" level="0"/>
+    <field field_ref="PARdf" level="0"/>
+    <field field_ref="PARdr" level="0"/>
+    <field field_ref="flx_fertil_no" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="CRF" grid_ref="grid_nvm_out" 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" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_mono" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_ORVOC" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_MBO" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_methanol" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_acetone" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_acetal" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_formal" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_acetic" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_formic" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_no_soil" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_no" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="pb" level="11"/>
+    <field field_ref="slowflow" level="11"/>
+    <field field_ref="qsintveg_tot" level="10"/>
+    <field field_ref="LAImean" level="0"/>
+    <field field_ref="mcs" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="mcr" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="nvg" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="alphavg" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="nroot" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="dlh" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="water2infilt" grid_ref="grid_nstm_out" level="11"/>
+    <field field_ref="flx_apinen" grid_ref="grid_nvm_out"  level="11" />
+    <field field_ref="flx_bpinen" grid_ref="grid_nvm_out"  level="11" />
+    <field field_ref="flx_limonen" grid_ref="grid_nvm_out" level="11" />
+    <field field_ref="flx_myrcen" grid_ref="grid_nvm_out"  level="11" />
+    <field field_ref="flx_sabinen" grid_ref="grid_nvm_out" level="11" />
+    <field field_ref="flx_camphen" grid_ref="grid_nvm_out" level="11" />
+    <field field_ref="flx_3caren" grid_ref="grid_nvm_out"  level="11" />
+    <field field_ref="flx_tbocimen" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_othermono" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="flx_sesquiter" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="fco2" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="cim" grid_ref="grid_nvm_out" level="11"/>
+    <field field_ref="kk_moy" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="psi_moy" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="profil_froz_hydro" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="pkappa" grid_ref="grid_ngrnd_out"  level="11"/>
+    <field field_ref="pkappa_snow" grid_ref="grid_nsnow_out" level="11"/>
+    <field field_ref="pcapa" grid_ref="grid_ngrnd_out"  level="11"/>
+    <field field_ref="pcapa_spec" grid_ref="grid_ngrnd_out"  level="11"/>
+    <field field_ref="pcapa_snow" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowtemp" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowtemp_weighted"  level="0"/>
+    <field field_ref="snowliq" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowdz" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowrho" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowheat" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowgrain" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowdepth"  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="alaimap"  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"/>
+    <field field_ref="frac_snow"  level="0"/>
+    <field field_ref="snowliqtot"  level="11"/>
+    <field field_ref="albedo_snow"  level="11"/>
+    <field field_ref="snowage_glob"  level="11"/>
+    <field field_ref="lake_overflow_coast" level="7"/>
+    <field field_ref="fraclut" grid_ref="grid_nlut_out" level="11"/>
+    <field field_ref="nwdFraclut" grid_ref="grid_nlut_out" level="11"/>
+    <field field_ref="humtot_lut" grid_ref="grid_nlut_out"  level="0"/>
+    <field field_ref="humtot_top_lut" grid_ref="grid_nlut_out"  level="0"/>
+    <field field_ref="mrro_lut" grid_ref="grid_nlut_out"  level="11"/>
+    <field field_ref="gpplut" grid_ref="grid_nlut_out"  level="11"/>
+    <field field_ref="nudgincswe" level="11"/>
+    <field field_ref="nudgincsm" level="11"/>
+    <field field_ref="cnc" level="11"/>
+    <field field_ref="mcfc" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="mcw" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="tmcs" level="11"/>
+    <field field_ref="tmcfc" level="11"/>
+    <field field_ref="wilt" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="fldcapacity" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="frac_snow_veg"  level="12"/>
+    <field field_ref="frac_snow_nobio" grid_ref="grid_nnobio_out"  level="12"/>
+    <field field_ref="snowdz_read_current" grid_ref="grid_nsnow_out"  level="12"/>
+    <field field_ref="snowrho_read_current" grid_ref="grid_nsnow_out"  level="12"/>
+    <field field_ref="snowtemp_read_current" grid_ref="grid_nsnow_out"  level="12"/>
+    <field field_ref="mask_snow_interp_out" grid_ref="grid_nsnow_out"  level="12"/>
+   </field_group>
+  </file>
+
+  <!-- Sechiba file 2 -->
+  <file id="sechiba2" name="sechiba_out_2" output_level="_AUTO_" output_freq="_AUTO_" enabled="_AUTO_">
+   <field_group freq_op="1ts" grid_ref="grid_landpoints_out" group_ref="remap_expr" >
+    <!-- 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" grid_ref="grid_ngrnd_out" 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" name="evapnu" level="2" unit="mm/d" > @vevapnu*86400  </field>
+    <field field_ref="temp_sol_new_C" 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="vevapp_day" 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" grid_ref="grid_nvm_out" 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" > @vevapsno*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="temp_air" level="4"/>
+    <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" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="inter" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="evapnu_soil" grid_ref="grid_nstm_out" level="4"/>
+    <field field_ref="drainage_soil" grid_ref="grid_nstm_out" level="4"/>
+    <field field_ref="transpir_soil" grid_ref="grid_nstm_out" level="4"/>
+    <field field_ref="runoff_soil" grid_ref="grid_nstm_out" 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" grid_ref="grid_nnobio_out" level="5"/>
+    <field field_ref="snownobioage" grid_ref="grid_nnobio_out" 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" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="maxvegetfrac" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="nobiofrac" grid_ref="grid_nnobio_out" level="5"/>
+    <field field_ref="temp_hydro" grid_ref="grid_nslm_out"  level="5"/>
+    <!-- level 6 -->
+    <field field_ref="humtot" level="6"/>
+    <field field_ref="humtot_liquid" level="6"/>
+    <field field_ref="tmc" grid_ref="grid_nstm_out" level="6"/>
+    <field field_ref="qsintveg" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="rstruct" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="r_soil" level="6"/>
+    <field field_ref="gpp" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="nee" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="maint_resp" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="hetero_resp" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="growth_resp" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="npp" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="precisol" grid_ref="grid_nvm_out" 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" > @irrigation*86400  </field>
+    <field field_ref="netirrig" name="netirrig" level="8" unit="mm/d" > @netirrig*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_daily" level="8" />
+    <field field_ref="vevapflo" name="evapflo" level="8" unit="mm/d" > @vevapflo*86400 </field>
+
+    <!-- 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" grid_ref="grid_nvm_out" 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" grid_ref="grid_nvm_out" level="9"/>
+    <!-- level 10 -->
+    <field field_ref="cimean" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="vbeta3" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="rveget" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="vbeta2" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="qsintmax" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="PAR" level="10"/>
+    <field field_ref="PARsun" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="PARsh" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="laisun" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="laish" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="PARsuntab" grid_ref="grid_nlaip1_out" level="10"/>
+    <field field_ref="PARshtab" grid_ref="grid_nlaip1_out" 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" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="CRF" grid_ref="grid_nvm_out" 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" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_mono" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_ORVOC" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_MBO" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_methanol" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_acetone" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_acetal" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_formal" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_acetic" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_formic" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_no_soil" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="flx_no" grid_ref="grid_nvm_out" level="10"/>
+    <field field_ref="pb" 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" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="mcr" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="nvg" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="alphavg" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="nroot" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="dlh" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="water2infilt" grid_ref="grid_nstm_out" level="11"/>
+    <field field_ref="kk_moy" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="psi_moy" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="profil_froz_hydro" grid_ref="grid_nslm_out" level="11"/>
+    <field field_ref="pkappa" grid_ref="grid_ngrnd_out"  level="11"/>
+    <field field_ref="pkappa_snow" grid_ref="grid_nsnow_out" level="11"/>
+    <field field_ref="pcapa" grid_ref="grid_ngrnd_out"  level="11"/>
+    <field field_ref="pcapa_spec" grid_ref="grid_ngrnd_out"  level="11"/>
+    <field field_ref="pcapa_snow" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowtemp" grid_ref="grid_nsnow_out"  level="0"/>
+    <field field_ref="snowtemp_weighted"  level="11"/>
+    <field field_ref="snowliq" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowdz" grid_ref="grid_nsnow_out"  level="0"/>
+    <field field_ref="snowrho" grid_ref="grid_nsnow_out"  level="0"/>
+    <field field_ref="snowheat" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowgrain" grid_ref="grid_nsnow_out"  level="11"/>
+    <field field_ref="snowdepth"  level="11"/>
+    <field field_ref="mc" grid_ref="grid_nslm_nstm_out" level="0"/>   <!-- mc is a 4 dimensional variable -->
+   </field_group>
+  </file>
+
+  <!-- Sechiba file 3 -->
+  <!-- This files contains all variables having more than one vertical axis -->
+  <file id="sechiba3" name="sechiba_history_4dim" output_level="_AUTO_" output_freq="_AUTO_" enabled="_AUTO_">
+   <field_group  freq_op="1ts" grid_ref="grid_landpoints_out" group_ref="remap_expr" >
+    <field field_ref="areas" level="1"/>
+    <field field_ref="contfrac" level="1"/>
+    <field field_ref="mc" grid_ref="grid_nslm_nstm_out" level="1"/>
+    <field field_ref="mc_read_current" grid_ref="grid_nslm_nstm_oust" level="1"/>
+    <field field_ref="kfact_root" grid_ref="grid_nslm_nstm_out" level="3"/>
+    <field field_ref="vegetmax_soil" grid_ref="grid_nvm_nstm_out" level="3"/>
+    <field field_ref="profil_froz_hydro_ns" grid_ref="grid_nslm_nstm_out" level="11"/>
+   </field_group>  
+  </file>
+
+
+  <!-- Sechiba alma file 1 -->
+  <file id="sechiba1_alma" name="sechiba_history_alma" output_level="10" output_freq="1d" enabled=".FALSE.">
+   <field_group  freq_op="1ts" grid_ref="grid_landpoints_out" group_ref="remap_expr" >
+    <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_new" 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="soilalb_bg" grid_ref="grid_albtyp_out" 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" grid_ref="grid_nvm_out" name="GPP" level="1"/>
+    <field field_ref="nee" grid_ref="grid_nvm_out" name="NEE" level="1"/>
+    <field field_ref="maint_resp" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="hetero_resp" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="growth_resp" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="npp" grid_ref="grid_nvm_out" 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" name="ESoil" level="1"/>
+    <field field_ref="vevapflo" name="EWater" level="1"/>
+    <field field_ref="ACond" level="1"/>
+    <field field_ref="temp_air" name="Tair" level="2"/>
+    <field field_ref="qair" name="Qair" level="2"/>
+    <field field_ref="vegetfrac" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="maxvegetfrac" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="nobiofrac" grid_ref="grid_nnobio_out" level="3"/>
+    <field field_ref="soilmoist" grid_ref="grid_nslm_out" level="7"/>
+    <field field_ref="humtot" name="RootMoist" long_name="Root zone soil water" level="1"/>
+    <field field_ref="ptn" grid_ref="grid_ngrnd_out" name="SoilTemp" level="7"/>
+    <field field_ref="vbeta1" name="SnowFrac" level="7"/>
+    <field field_ref="albedo_snow" level="7"/>
+    <field field_ref="snowdz" grid_ref="grid_nsnow_out" name="SnowDepth" level="7"/>
+    <field field_ref="temp_sol_new" name="RadT" level="1"/>
+    <field field_ref="twbr" level="1"/>
+   </field_group>
+  </file>
+
+  <!-- Sechiba alma file 2 -->
+  <file id="sechiba2_alma" name="sechiba_out_2_alma" output_level="10" output_freq="1d" enabled=".FALSE.">
+   <field_group  freq_op="1ts" grid_ref="grid_landpoints_out" group_ref="remap_expr" >
+    <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_new" 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="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" grid_ref="grid_nvm_out" name="GPP" level="1"/>
+    <field field_ref="nee" grid_ref="grid_nvm_out" name="NEE" level="1"/>
+    <field field_ref="maint_resp" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="hetero_resp" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="growth_resp" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="npp" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="delsoilmoist" level="1"/>
+    <field field_ref="delintercept" level="1"/>
+    <field field_ref="delswe" level="1"/>
+    <field field_ref="vevapnu" name="ESoil" level="1"/>
+    <field field_ref="vevapflo" name="EWater" level="1"/>
+    <field field_ref="ACond" level="1"/>
+    <field field_ref="soilmoist" grid_ref="grid_nslm_out" level="7"/>
+    <field field_ref="humtot" name="RootMoist" long_name="Root zone soil water" level="1"/>
+    <field field_ref="ptn" grid_ref="grid_ngrnd_out" name="SoilTemp" level="7"/>
+    <field field_ref="vbeta1" name="SnowFrac" level="7"/>
+    <field field_ref="albedo_snow" level="7"/>
+    <field field_ref="snowdz" grid_ref="grid_nsnow_out" name="SnowDepth" level="7"/>
+    <field field_ref="vegetfrac" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="maxvegetfrac" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="nobiofrac" grid_ref="grid_nnobio_out" level="3"/>
+    <field field_ref="temp_sol_new" name="RadT" level="5"/>
+   </field_group>
+
+  </file>
+
+  <!-- Definition of files with stomate diagnostics -->
+  <!-- Stomate file 1 -->
+  <file id="stomate1" name="stomate_history" output_level="_AUTO_" output_freq="_AUTO_" enabled="_AUTO_">
+   <field_group  freq_op="1ts" grid_ref="grid_landpoints_out" group_ref="remap_expr" >
+
+
+    <!-- lly added variables -->
+    <field field_ref="TOTAL_LITTERFALL" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN_CL1" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN_CL2" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN_CL3" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN_CL4" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN_Total_lly" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_BM_CL1" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_BM_CL2" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_BM_CL3" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_BM_CL4" grid_ref="grid_nvm_out" level="0"/>
+    <!-- liulya 20220220 -->
+    <field field_ref="LEAF_TURN_RATE_CL1" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN_RATE_CL2" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN_RATE_CL3" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN_RATE_CL4" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_Frac_CL1" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_Frac_CL2" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_Frac_CL3" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_Frac_CL4" grid_ref="grid_nvm_out" level="0"/>
+    <!-- lly modi -->
+    <field field_ref="BM_ALLOC_LEAF" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="BM_ALLOC_SAP_AB" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="BM_ALLOC_SAP_BE" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="BM_ALLOC_ROOT" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="BM_ALLOC_FRUIT" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="BM_ALLOC_RES" grid_ref="grid_nvm_out" level="0"/>
+    <!--from level 5 -->
+
+    <!--liuly modi-->
+    <field field_ref="fVegLitter" level="0"/>
+    <field field_ref="fLitterSoil" level="0"/>
+    <!--from stomate ipcc history -->
+     
+    <!-- level 1 -->
+    <field field_ref="RESOLUTION_X" level="1"/>
+    <field field_ref="RESOLUTION_Y" level="1"/>
+    <field field_ref="CONTFRAC_STOMATE" level="0"/>
+    <field field_ref="areas" level="0"/>
+    <field field_ref="T2M_MONTH" level="1"/>
+    <field field_ref="T2M_WEEK" level="1"/>
+    <field field_ref="firefrac" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="CO2_FIRE" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="CO2_TAKEN" grid_ref="grid_nvm_out" level="1"/>
+    <!-- lly modi LAI -->
+    <field field_ref="LAI" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LAI_CL1" grid_ref="grid_nvm_out" level="0"/>                                     
+    <field field_ref="LAI_CL2" grid_ref="grid_nvm_out" level="0"/>                                     
+    <field field_ref="LAI_CL3" grid_ref="grid_nvm_out" level="0"/>                                     
+    <field field_ref="LAI_CL4" grid_ref="grid_nvm_out" level="0"/> 
+    <field field_ref="VEGET_COV_MAX" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="NPP_STOMATE" grid_ref="grid_nvm_out" level="0"/>
+    <!-- lly -->
+    <field field_ref="GPP" grid_ref="grid_nvm_out" long_name="Gross primary productivity (positive from atm to land)" unit="gC/day/m^2" level="0"/>
+    <field field_ref="MAINT_RESP" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="GROWTH_RESP" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="HET_RESP" grid_ref="grid_nvm_out" level="0"/>
+    <!-- level 2 -->
+    <field field_ref="LEAF_M" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="SAP_M_AB" grid_ref="grid_nvm_out" level="2"/>
+    <field field_ref="SAP_M_BE" grid_ref="grid_nvm_out" level="2"/>
+    <field field_ref="HEART_M_AB" grid_ref="grid_nvm_out" level="2"/>
+    <field field_ref="HEART_M_BE" grid_ref="grid_nvm_out" level="2"/>
+    <field field_ref="ROOT_M" grid_ref="grid_nvm_out" level="2"/>
+    <field field_ref="FRUIT_M" grid_ref="grid_nvm_out" level="2"/>
+    <field field_ref="RESERVE_M" grid_ref="grid_nvm_out" level="2"/>
+
+    <!-- level 3 -->
+    <field field_ref="IND" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="ADAPTATION" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="REGENERATION" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="CN_IND" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="WOODMASS_IND" grid_ref="grid_nvm_out" level="3"/>
+    <field field_ref="MOISTRESS" grid_ref="grid_nvm_out" level="3"/>
+    
+    <!-- level 4 -->
+    <field field_ref="SAP_AB_TURN" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="ROOT_TURN" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="FRUIT_TURN" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="TOTAL_BM_LITTER" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_BM_LITTER" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="SAP_AB_BM_LITTER" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="SAP_BE_BM_LITTER" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="HEART_AB_BM_LITTER" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="HEART_BE_BM_LITTER" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="ROOT_BM_LITTER" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="FRUIT_BM_LITTER" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="RESERVE_BM_LITTER" grid_ref="grid_nvm_out" level="4"/>
+    <field field_ref="TOTAL_M" grid_ref="grid_nvm_out" level="0"/>
+    <!--liuly Total turn-->
+    <field field_ref="TOTAL_TURN" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="LEAF_TURN" grid_ref="grid_nvm_out" level="0"/>
+    <!-- level 5 -->
+    <field field_ref="LITTER_STR_AB" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="LITTER_MET_AB" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="LITTER_STR_BE" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="LITTER_MET_BE" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="DEADLEAF_COVER" level="5"/>
+    <field field_ref="TOTAL_SOIL_CARB" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="CARBON_ACTIVE" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="CARBON_SLOW" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="CARBON_PASSIVE" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="LITTERHUM" level="5"/>
+
+    <field field_ref="HERBIVORES" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="TURNOVER_TIME" grid_ref="grid_nvm_out" level="5"/>
+    <field field_ref="PROD10" grid_ref="grid_P11_out" level="5"/>
+    <field field_ref="FLUX10" grid_ref="grid_P10_out" level="5"/>
+    <field field_ref="PROD100" grid_ref="grid_P101_out" level="5"/>
+    <field field_ref="FLUX100" grid_ref="grid_P100_out" level="5"/>
+    <field field_ref="CONVFLUX" level="0"/>
+    <field field_ref="CFLUX_PROD10" level="0"/>
+    <field field_ref="CFLUX_PROD100" level="0"/>
+    <field field_ref="fDeforestToProduct" level="5"/>
+    <field field_ref="fDeforestToProduct_post" level="5"/>
+    <field field_ref="PROD10_HARVEST" grid_ref="grid_P11_out" level="5"/>
+    <field field_ref="FLUX10_HARVEST" grid_ref="grid_P10_out" level="5"/>
+    <field field_ref="PROD100_HARVEST" grid_ref="grid_P101_out" level="5"/>
+    <field field_ref="FLUX100_HARVEST" grid_ref="grid_P100_out" level="5"/>
+    <field field_ref="CONVFLUX_HARVEST" level="5"/>
+    <field field_ref="CFLUX_PROD10_HARVEST" level="5"/>
+    <field field_ref="CFLUX_PROD100_HARVEST" level="5"/>
+    <field field_ref="WOOD_HARVEST" level="0"/>
+    <field field_ref="WOOD_HARVEST_PFT" grid_ref="grid_nvm_out" level="0"/>
+    <field field_ref="HARVEST_ABOVE" level="0"/>
+    <!-- level 6 -->
+    <field field_ref="VCMAX" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="VCMAX_CL1" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="VCMAX_CL2" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="VCMAX_CL3" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="VCMAX_CL4" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="LEAF_AGE" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="LEAF_AGE_CL1" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="LEAF_AGE_CL2" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="LEAF_AGE_CL3" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="LEAF_AGE_CL4" grid_ref="grid_nvm_out" level="1"/>
+    <!--liuly above-->
+    <field field_ref="mortality" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="firedeath" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="IND_ESTAB" grid_ref="grid_nvm_out" level="6"/>
+    <field field_ref="ESTABTREE" level="6"/>
+    <field field_ref="ESTABGRASS" level="6"/>
+    <field field_ref="light_death" grid_ref="grid_nvm_out" level="6"/>
+    <!-- level 7 -->
+    <field field_ref="AGE" grid_ref="grid_nvm_out" level="7"/>
+    <field field_ref="HEIGHT" grid_ref="grid_nvm_out" level="7"/>
+    <!-- level 9 -->
+    <field field_ref="WHEN_GROWTHINIT" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="PFTPRESENT" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="GDD_MIDWINTER" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="GDD_M5_DORMANCE" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="NCD_DORMANCE" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="ALLOW_INITPHENO" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="BEGIN_LEAVES" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="t2m_longterm" level="9"/>
+    <field field_ref="TSEASON"  level="9"/>
+    <field field_ref="TMIN_SPRING_TIME" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="ONSET_DATE" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="FPC_MAX" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="MAXFPC_LASTYEAR" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="clitterlut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="csoillut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="cveglut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="lailut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="ctotfirelut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="ralut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="rhlut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="npplut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="cproductlut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="flulccproductlut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="flulccresiduelut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="flulccresidue" grid_ref="grid_nvm_out" level="9"/>
+    <field field_ref="flulccatmlut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="necbLut" grid_ref="grid_nlut_out" level="9"/>
+    <field field_ref="fProductDecomp" level="9"/>
+
+    <!-- level 10 -->
+    <field field_ref="FIREINDEX" grid_ref="grid_nvm_out" level="10"/>
+    
+   </field_group>  
+    
+  </file>
+
+  <!-- Stomate file 2 -->
+  <file id="stomate2" name="stomate_ipcc_history" output_level="_AUTO_" output_freq="_AUTO_" enabled="_AUTO_">
+   <field_group  freq_op="1ts" grid_ref="grid_landpoints_out" group_ref="remap_expr" >
+    <!-- level 1 -->
+    <field field_ref="RESOLUTION_X" level="1"/>
+    <field field_ref="RESOLUTION_Y" level="1"/>
+    <field field_ref="CONTFRAC_STOMATE" level="0"/>
+    <field field_ref="areas" level="0"/>
+    <field field_ref="cVeg" level="1"/>
+    <field field_ref="cVegGrass" level="1"/>
+    <field field_ref="cVegCrop" level="0"/>
+    <field field_ref="cVegTree" level="1"/>
+    <field field_ref="cLitter" level="1"/>
+    <field field_ref="cLitterGrass" level="1"/>
+    <field field_ref="cLitterCrop" level="0"/>
+    <field field_ref="cLitterTree" level="1"/>
+    <field field_ref="cOther" level="1"/>
+    <field field_ref="cSoil" level="1"/>
+    <field field_ref="cSoilGrass" level="1"/>
+    <field field_ref="cSoilCrop" level="0"/>
+    <field field_ref="cSoilTree" level="1"/>
+    <field field_ref="cLand" level="1"/>
+    <field field_ref="cProduct" level="0"/>
+    <field field_ref="cMassVariation" level="0"/>
+    <field field_ref="lai_ipcc" level="0"/>
+    <field field_ref="gpp_ipcc" level="0"/>
+    <field field_ref="ra" level="0"/>
+    <field field_ref="raGrass" level="1"/>
+    <field field_ref="raCrop" level="0"/>
+    <field field_ref="raTree" level="1"/>
+    <field field_ref="npp_ipcc" level="1"/>
+    <field field_ref="rh" level="1"/>
+    <field field_ref="rhSoil" level="1"/>
+    <field field_ref="rhLitter" level="1"/>
+    <field field_ref="tSoilPools" grid_ref="grid_ncarb_out" level="1"/>
+    <field field_ref="fFire" level="1"/>
+    <field field_ref="fHarvest" level="1"/>
+    <field field_ref="fWoodharvest" level="0"/>
+    <field field_ref="fLuc" level="0"/>
+    <field field_ref="fAnthDisturb" level="1"/>
+    <field field_ref="nbp" level="0"/>
+    <field field_ref="fVegLitter" level="0"/>
+    <field field_ref="fLitterSoil" level="0"/>
+    <field field_ref="cLeaf" level="0"/>
+    <field field_ref="cWood" level="0"/>
+    <field field_ref="cStem" level="1"/>
+    <field field_ref="cRoot" level="0"/>
+    <field field_ref="cMisc" level="0"/>
+    <field field_ref="cLitterAbove" level="0"/>
+    <field field_ref="cLitterBelow" level="0"/>
+    <field field_ref="cSoilFast" level="0"/>
+    <field field_ref="cSoilMedium" level="0"/>
+    <field field_ref="cSoilSlow" level="0"/>
+    <field field_ref="cSoilPools" grid_ref="grid_ncarb_out" level="1"/>
+    <field field_ref="landCoverFrac" grid_ref="grid_nvm_out" level="1"/>
+    <field field_ref="treeFracPrimDec" level="0"/>
+    <field field_ref="treeFracPrimEver" level="0"/>
+    <field field_ref="c3PftFrac" level="0"/>
+    <field field_ref="c4PftFrac" level="0"/>
+    <field field_ref="rGrowth" level="0"/>
+    <field field_ref="rMaint" level="0"/>
+    <field field_ref="rGrowth_ipcc" level="1"/>
+    <field field_ref="rMaint_ipcc" level="1"/>
+    <field field_ref="nppLeaf" level="0"/>
+    <field field_ref="nppWood" level="0"/>
+    <field field_ref="nppStem" level="1"/>
+    <field field_ref="nppRoot" level="0"/>
+    <field field_ref="nppGrass" level="1"/>
+    <field field_ref="nppCrop" level="0"/>
+    <field field_ref="nppTree" level="1"/>
+    <field field_ref="nppOther" level="1"/>
+    <field field_ref="nep" level="0"/>
+   </field_group>
+    
+  </file>
+</file_definition>
Index: /branches/publications/ORCHIDEE-AFP/src_xml/iodef.xml
===================================================================
--- /branches/publications/ORCHIDEE-AFP/src_xml/iodef.xml	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/src_xml/iodef.xml	(revision 8430)
@@ -0,0 +1,37 @@
+<?xml version="1.0"?>
+<!-- =========================================================================================================== -->
+<!-- iodef.xml                                                                                                   -->
+<!--   Main configuration file for reading and writing files using XIOS                                          -->
+<!--   This file includes 2 mandatory files for ORCHIDEE:                                                        -->
+<!--      - context_orchidee.xml containing all specifications for writing of diagnostic output files            -->
+<!--      - context_input_orchidee.xml containing specifications for reading and interpolating input files.      -->
+<!--                                                                                                             -->
+<!-- $HeadURL$                           -->
+<!-- $Date$                                                     -->
+<!-- $Revision$                                                                                           -->
+<!-- =========================================================================================================== -->
+
+<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 files context_orchidee.xml and context_input_orchidee.xml are included here.                            -->
+  <!-- These files need to exist in the run directory during run time.                                             -->
+  <!-- =========================================================================================================== -->
+  <context id="orchidee" src="./context_orchidee.xml"/>
+  <context id="orchidee" src="./context_input_orchidee.xml"/>
+
+</simulation>
Index: /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/COPYRIGHT.txt
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/COPYRIGHT.txt	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/COPYRIGHT.txt	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/LICENSE.html
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/LICENSE.html	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/LICENSE.html	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/README
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/README	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/README	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/bin/fcm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/bin/fcm_graphic_diff
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_graphic_diff	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_graphic_diff	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/bin/fcm_gui
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_gui	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_gui	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/bin/fcm_gui_internal
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_gui_internal	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_gui_internal	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/bin/fcm_internal
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_internal	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_internal	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/bin/fcm_setup_konqueror
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_setup_konqueror	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_setup_konqueror	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/bin/fcm_update_version_dir.pl
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_update_version_dir.pl	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/bin/fcm_update_version_dir.pl	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/etc/fcm.cfg.eg
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/etc/fcm.cfg.eg	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/etc/fcm.cfg.eg	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/etc/fcm_gui.desktop
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/etc/fcm_gui.desktop	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/etc/fcm_gui.desktop	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/Build.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Build.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Build.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/BuildTask.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/BuildTask.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/BuildTask.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/CfgFile.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/CfgFile.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/CfgFile.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/Cm.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Cm.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Cm.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/CmBranch.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/CmBranch.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/CmBranch.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/CmUrl.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/CmUrl.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/CmUrl.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/Config.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Config.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Config.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/Extract.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Extract.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Extract.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/SrcFile.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/SrcFile.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/SrcFile.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/Timer.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Timer.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Timer.pm	(revision 8430)
@@ -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-AFP/tools/FCM_V1.2/lib/Fcm/Util.pm
===================================================================
--- /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Util.pm	(revision 8430)
+++ /branches/publications/ORCHIDEE-AFP/tools/FCM_V1.2/lib/Fcm/Util.pm	(revision 8430)
@@ -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__
