Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/NEMO_book.tex
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/NEMO_book.tex	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/NEMO_book.tex	(revision 10251)
@@ -215,6 +215,6 @@
 %\date{\today}
 \date{
-November 2015  \\
-{\small  -- version 3.6 stable --} \\
+November 2014  \\
+{\small  -- version 3.6 --} \\
 ~  \\
 \textit{\small Note du P\^ole de mod\'{e}lisation de l'Institut Pierre-Simon Laplace No 27 }\\
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Biblio/Biblio.bib
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Biblio/Biblio.bib	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Biblio/Biblio.bib	(revision 10251)
@@ -276,7 +276,7 @@
   author = {A. Beckmann and H. Goosse},
   title = {A parameterization of ice shelf-ocean interaction for climate models},
-  journal = OM,
-  year = {2003},
-  volume = {5},
+  journal = OM
+  year = {2003}
+  volume = {5}
   pages = {157--170}
 }
@@ -1124,14 +1124,4 @@
 }
 
-@ARTICLE{Graham_McDougall_JPO13,
-  author = {F.S. Graham and T.J. McDougall},
-  title = {Quantifying the nonconservative production of conservative temperature, potential temperature, and entropy},
-  journal = JPO,
-  year = {2013},
-  volume = {43},
-  pages = {838--862},
-  url ={http://dx.doi.org/10.1175/JPO-D-11-0188.1}
-}
-
 @ARTICLE{Greatbatch_JGR94,
   author = {R. J. Greatbatch},
@@ -1438,14 +1428,4 @@
   publisher = {LA-CC-06-012, Los Alamos National Laboratory, N.M.},
   year = {2008}
-}
-
-@TECHREPORT{TEOS10,
-  author = {IOC and SCOR and IAPSO},
-  title = {The international thermodynamic equation of seawater - 2010: Calculation and use of thermodynamic properties},
-  institution = {Intergovernmental Oceanographic Commission},
-  publisher = {Manuals and Guides No. 56, UNESCO (English)},
-  year = {2010},
-  pages = {196pp},
-  url = {http://www.teos-10.org/pubs/TEOS-10_Manual.pdf}
 }
 
@@ -2508,27 +2488,4 @@
 }
 
-@article{Roquet_OM2015,
-author = "F. Roquet and G. Madec and T.J. McDougall and P.M. Barker",
-title = "Accurate polynomial expressions for the density and specific volume of seawater using the TEOS-10 standard ",
-journal = OM,
-volume = "90",
-pages = "29--43",
-year = "2015",
-issn = "1463-5003",
-doi = "10.1016/j.ocemod.2015.04.002",
-url = "http://dx.doi.org/10.1016/j.ocemod.2015.04.002"
-}
-
-@article{Roquet_JPO2015,
-author = "F. Roquet and G. Madec and L. Brodeau and J. Nycander",
-title = "Defining a Simplified Yet Realistic Equation of State for Seawater",
-journal = JPO,
-volume = "45",
-pages = "2564--2579",
-year = "2015",
-doi = "10.1175/JPO-D-15-0080.1",
-url = "http://dx.doi.org/10.1175/JPO-D-15-0080.1"
-}
-
 @ARTICLE{Roullet_Madec_JGR00,
   author = {G. Roullet and G. Madec},
@@ -2885,13 +2842,4 @@
   volume = {27},
   pages = {54--69}
-}
-
-@book{Vallis06,
-author = {Vallis, G. K.},
-title = {Atmospheric and Oceanic Fluid Dynamics},
-publisher = {Cambridge University Press},
-address = {Cambridge, U.K.},
-year = {2006},
-pages = {745},
 }
 
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Chapters/Chap_TRA.tex
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 10251)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter 1 ——— Ocean Tracers (TRA)
+% Chapter 1 � Ocean Tracers (TRA)
 % ================================================================
 \chapter{Ocean Tracers (TRA)}
@@ -859,5 +859,5 @@
 \label{TRA_bbc}
 %--------------------------------------------nambbc--------------------------------------------------------
-\namdisplay{nambbc}
+\namdisplay{namtra_bbc}
 %--------------------------------------------------------------------------------------------------------------
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -1167,116 +1167,61 @@
 %        Equation of State
 % -------------------------------------------------------------------------------------------------------------
-\subsection{Equation Of Seawater (\np{nn\_eos} = -1, 0, or 1)}
+\subsection{Equation of State (\np{nn\_eos} = 0, 1 or 2)}
 \label{TRA_eos}
 
-The Equation Of Seawater (EOS) is an empirical nonlinear thermodynamic relationship 
-linking seawater density, $\rho$, to a number of state variables, 
-most typically temperature, salinity and pressure. 
-Because density gradients control the pressure gradient force through the hydrostatic balance, 
-the equation of state provides a fundamental bridge between the distribution of active tracers 
-and the fluid dynamics. Nonlinearities of the EOS are of major importance, in particular 
-influencing the circulation through determination of the static stability below the mixed layer, 
-thus controlling rates of exchange between the atmosphere  and the ocean interior \citep{Roquet_JPO2015}. 
-Therefore an accurate EOS based on either the 1980 equation of state (EOS-80, \cite{UNESCO1983}) 
-or TEOS-10 \citep{TEOS10} standards should be used anytime a simulation of the real 
-ocean circulation is attempted \citep{Roquet_JPO2015}. 
-The use of TEOS-10 is highly recommended because 
-\textit{(i)} it is the new official EOS, 
-\textit{(ii)} it is more accurate, being based on an updated database of laboratory measurements, and 
-\textit{(iii)} it uses Conservative Temperature and Absolute Salinity (instead of potential temperature 
-and practical salinity for EOS-980, both variables being more suitable for use as model variables 
-\citep{TEOS10, Graham_McDougall_JPO13}. 
-EOS-80 is an obsolescent feature of the NEMO system, kept only for backward compatibility.
-For process studies, it is often convenient to use an approximation of the EOS. To that purposed, 
-a simplified EOS (S-EOS) inspired by \citet{Vallis06} is also available.
-
-In the computer code, a density anomaly, $d_a= \rho / \rho_o - 1$, 
-is computed, with $\rho_o$ a reference density. Called \textit{rau0} 
-in the code, $\rho_o$ is set in \mdl{phycst} to a value of $1,026~Kg/m^3$. 
+It is necessary to know the equation of state for the ocean very accurately 
+to determine stability properties (especially the Brunt-Vais\"{a}l\"{a} frequency), 
+particularly in the deep ocean. The ocean seawater volumic mass, $\rho$, 
+abusively called density, is a non linear empirical function of \textit{in situ} 
+temperature, salinity and pressure. The reference equation of state is that 
+defined by the Joint Panel on Oceanographic Tables and Standards 
+\citep{UNESCO1983}. It was the standard equation of state used in early 
+releases of OPA. However, even though this computation is fully vectorised, 
+it is quite time consuming ($15$ to $20${\%} of the total CPU time) since 
+it requires the prior computation of the \textit{in situ} temperature from the 
+model \textit{potential} temperature using the \citep{Bryden1973} polynomial 
+for adiabatic lapse rate and a $4^th$ order Runge-Kutta integration scheme. 
+Since OPA6, we have used the \citet{JackMcD1995} equation of state for 
+seawater instead. It allows the computation of the \textit{in situ} ocean density 
+directly as a function of \textit{potential} temperature relative to the surface 
+(an \NEMO variable), the practical salinity (another \NEMO variable) and the 
+pressure (assuming no pressure variation along geopotential surfaces, $i.e.$ 
+the pressure in decibars is approximated by the depth in meters). 
+Both the \citet{UNESCO1983} and \citet{JackMcD1995} equations of state 
+have exactly the same except that the values of the various coefficients have 
+been adjusted by \citet{JackMcD1995} in order to directly use the \textit{potential} 
+temperature instead of the \textit{in situ} one. This reduces the CPU time of the 
+\textit{in situ} density computation to about $3${\%} of the total CPU time, 
+while maintaining a quite accurate equation of state.
+
+In the computer code, a \textit{true} density anomaly, $d_a= \rho / \rho_o - 1$, 
+is computed, with $\rho_o$ a reference volumic mass. Called \textit{rau0} 
+in the code, $\rho_o$ is defined in \mdl{phycst}, and a value of $1,035~Kg/m^3$. 
 This is a sensible choice for the reference density used in a Boussinesq ocean 
 climate model, as, with the exception of only a small percentage of the ocean, 
-density in the World Ocean varies by no more than 2$\%$ from that value \citep{Gill1982}.
-
-Options are defined through the  \ngn{nameos} namelist variables, and in particular \np{nn\_eos} 
-which controls the EOS used (=-1 for TEOS10 ; =0 for EOS-80 ; =1 for S-EOS).
-\begin{description}
-
-\item[\np{nn\_eos}$=-1$] the polyTEOS10-bsq equation of seawater \citep{Roquet_OM2015} is used.  
-The accuracy of this approximation is comparable to the TEOS-10 rational function approximation, 
-but it is optimized for a boussinesq fluid and the polynomial expressions have simpler 
-and more computationally efficient expressions for their derived quantities 
-which make them more adapted for use in ocean models. 
-Note that a slightly higher precision polynomial form is now used replacement of the TEOS-10 
-rational function approximation for hydrographic data analysis  \citep{TEOS10}. 
-A key point is that conservative state variables are used: 
-Absolute Salinity (unit: g/kg, notation: $S_A$) and Conservative Temperature (unit: $\degres C$, notation: $\Theta$).
-The pressure in decibars is approximated by the depth in meters. 
-With TEOS10, the specific heat capacity of sea water, $C_p$, is a constant. It is set to 
-$C_p=3991.86795711963~J\,Kg^{-1}\,\degres K^{-1}$, according to \citet{TEOS10}.
-
-Choosing polyTEOS10-bsq implies that the state variables used by the model are 
-$\Theta$ and $S_A$. In particular, the initial state deined by the user have to be given as 
-\textit{Conservative} Temperature and \textit{Absolute} Salinity. 
-In addition, setting \np{ln\_useCT} to \textit{true} convert the Conservative SST to potential SST 
-prior to either computing the air-sea and ice-sea fluxes (forced mode) 
-or sending the SST field to the atmosphere (coupled mode).
-
-\item[\np{nn\_eos}$=0$] the polyEOS80-bsq equation of seawater is used.
-It takes the same polynomial form as the polyTEOS10, but the coefficients have been optimized 
-to accurately fit EOS80 (Roquet, personal comm.). The state variables used in both the EOS80 
-and the ocean model are: 
-the Practical Salinity ((unit: psu, notation: $S_p$)) and Potential Temperature (unit: $\degres C$, notation: $\theta$).
-The pressure in decibars is approximated by the depth in meters.  
-With thsi EOS, the specific heat capacity of sea water, $C_p$, is a function of temperature, 
-salinity and pressure \citep{UNESCO1983}. Nevertheless, a severe assumption is made in order to 
-have a heat content ($C_p T_p$) which is conserved by the model: $C_p$ is set to a constant 
-value, the TEOS10 value. 
- 
-\item[\np{nn\_eos}$=1$] a simplified EOS (S-EOS) inspired by \citet{Vallis06} is chosen, 
-the coefficients of which has been optimized to fit the behavior of TEOS10 (Roquet, personal comm.) 
-(see also \citet{Roquet_JPO2015}). It provides a simplistic linear representation of both 
-cabbeling and thermobaricity effects which is enough for a proper treatment of the EOS 
-in theoretical studies \citep{Roquet_JPO2015}.
+density in the World Ocean varies by no more than 2$\%$ from $1,035~kg/m^3$ 
+\citep{Gill1982}.
+
+Options are defined through the  \ngn{nameos} namelist variables.
+The default option (namelist parameter \np{nn\_eos}=0) is the \citet{JackMcD1995} 
+equation of state. Its use is highly recommended. However, for process studies, 
+it is often convenient to use a linear approximation of the density.
 With such an equation of state there is no longer a distinction between 
-\textit{conservative} and \textit{potential} temperature, as well as between \textit{absolute} 
-and \textit{practical} salinity.
-S-EOS takes the following expression:
-\begin{equation} \label{Eq_tra_S-EOS}
+\textit{in situ} and \textit{potential} density and both cabbeling and thermobaric
+effects are removed.
+Two linear formulations are available: a function of $T$ only (\np{nn\_eos}=1) 
+and a function of both $T$ and $S$ (\np{nn\_eos}=2):
+\begin{equation} \label{Eq_tra_eos_linear}
 \begin{split}
-  d_a(T,S,z)  =  ( & - a_0 \; ( 1 + 0.5 \; \lambda_1 \; T_a + \mu_1 \; z ) * T_a  \\
-                                & + b_0 \; ( 1 - 0.5 \; \lambda_2 \; S_a - \mu_2 \; z ) * S_a  \\
-                                & - \nu \; T_a \; S_a \;  ) \; / \; \rho_o                     \\
-  with \ \  T_a = T-10  \; ;  & \;  S_a = S-35  \; ;\;  \rho_o = 1026~Kg/m^3
+  d_a(T)       &=  \rho (T)      /  \rho_o   - 1     =  \  0.0285         -  \alpha   \;T     \\ 
+  d_a(T,S)    &=  \rho (T,S)   /  \rho_o   - 1     =  \  \beta \; S       -  \alpha   \;T    
 \end{split}
 \end{equation} 
-where the computer name of the coefficients as well as their standard value are given in \ref{Tab_SEOS}.
-In fact, when choosing S-EOS, various approximation of EOS can be specified simply by changing 
-the associated coefficients. 
-Setting to zero the two thermobaric coefficients ($\mu_1$, $\mu_2$) remove thermobaric effect from S-EOS.
-setting to zero the three cabbeling coefficients ($\lambda_1$, $\lambda_2$, $\nu$) remove cabbeling effect from S-EOS.
-Keeping non-zero value to $a_0$ and $b_0$ provide a linear EOS function of T and S.
-
-\end{description}
-
-
-%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-\begin{table}[!tb]
-\begin{center} \begin{tabular}{|p{26pt}|p{72pt}|p{56pt}|p{136pt}|}
-\hline
-coeff.	& computer name   & S-EOS		&  description		                  \\ \hline
-$a_0$       & \np{nn\_a0}     & 1.6550 $10^{-1}$ &  linear thermal expansion coeff. 	\\ \hline
-$b_0$	      & \np{nn\_b0} 	   & 7.6554 $10^{-1}$ &  linear haline  expansion coeff. 	\\ \hline
-$\lambda_1$	& \np{nn\_lambda1}& 5.9520 $10^{-2}$ &  cabbeling coeff. in $T^2$ 	      \\ \hline
-$\lambda_2$	& \np{nn\_lambda2}& 5.4914 $10^{-4}$ &  cabbeling coeff. in $S^2$	 	   \\ \hline
-$\nu$       & \np{nn\_nu}     & 2.4341 $10^{-3}$ &  cabbeling coeff. in $T \, S$ 	   \\ \hline
-$\mu_1$     & \np{nn\_mu1} 	& 1.4970 $10^{-4}$ &  thermobaric coeff. in T    	   \\ \hline
-$\mu_2$     & \np{nn\_mu2} 	& 1.1090 $10^{-5}$ &  thermobaric coeff. in S   	      \\ \hline
-\end{tabular}
-\caption{ \label{Tab_SEOS}
-Standard value of S-EOS coefficients. }
-\end{center}
-\end{table}
-%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
+where $\alpha$ and $\beta$ are the thermal and haline expansion 
+coefficients, and $\rho_o$, the reference volumic mass, $rau0$. 
+($\alpha$ and $\beta$ can be modified through the \np{rn\_alpha} and 
+\np{rn\_beta} namelist variables). Note that when $d_a$ is a function 
+of $T$ only (\np{nn\_eos}=1), the salinity is a passive tracer and can be 
+used as such.
 
 % -------------------------------------------------------------------------------------------------------------
@@ -1287,28 +1232,50 @@
 
 An accurate computation of the ocean stability (i.e. of $N$, the brunt-Vais\"{a}l\"{a}
- frequency) is of paramount importance as determine the ocean stratification and 
- is used in several ocean parameterisations (namely TKE, GLS, Richardson number dependent 
- vertical diffusion, enhanced vertical diffusion, non-penetrative convection, tidal mixing 
- parameterisation, iso-neutral diffusion). In particular, $N^2$ has to be computed at the local pressure 
- (pressure in decibar being approximated by the depth in meters). The expression for $N^2$ 
- is given by: 
+ frequency) is of paramount importance as it is used in several ocean 
+ parameterisations (namely TKE, KPP, Richardson number dependent 
+ vertical diffusion, enhanced vertical diffusion, non-penetrative convection, 
+ iso-neutral diffusion). In particular, one must be aware that $N^2$ has to 
+ be computed with an \textit{in situ} reference. The expression for $N^2$ 
+ depends on the type of equation of state used (\np{nn\_eos} namelist parameter).
+
+For \np{nn\_eos}=0 (\citet{JackMcD1995} equation of state), the \citet{McDougall1987} 
+polynomial expression is used (with the pressure in decibar approximated by 
+the depth in meters): 
 \begin{equation} \label{Eq_tra_bn2}
+N^2 = \frac{g}{e_{3w}} \; \beta   \ 
+	   \left(  \alpha / \beta \ \delta_{k+1/2}[T]     - \delta_{k+1/2}[S]   \right) 
+\end{equation} 
+where $\alpha$ and $\beta$ are the thermal and haline expansion coefficients. 
+They are a function of  $\overline{T}^{\,k+1/2},\widetilde{S}=\overline{S}^{\,k+1/2} - 35.$, 
+and  $z_w$, with $T$ the \textit{potential} temperature and $\widetilde{S}$ a salinity anomaly. 
+Note that both $\alpha$ and $\beta$ depend on \textit{potential} 
+temperature and salinity which are averaged at $w$-points prior 
+to the computation instead of being computed at $T$-points and 
+then averaged to $w$-points.
+
+When a linear equation of state is used (\np{nn\_eos}=1 or 2, 
+\eqref{Eq_tra_bn2} reduces to:
+\begin{equation} \label{Eq_tra_bn2_linear}
 N^2 =	\frac{g}{e_{3w}} \left(   \beta \;\delta_{k+1/2}[S] - \alpha \;\delta_{k+1/2}[T]   \right)
 \end{equation} 
-where $(T,S) = (\Theta, S_A)$ for TEOS10, $= (\theta, S_p)$ for TEOS-80, or $=(T,S)$ for S-EOS, 
-and, $\alpha$ and $\beta$ are the thermal and haline expansion coefficients. 
-The coefficients are a polynomial function of temperature, salinity and depth which expression 
-depends on the chosen EOS. They are computed through \textit{eos\_rab}, a \textsc{Fortran} 
-function that can be found in \mdl{eosbn2}.
-
-
-% -------------------------------------------------------------------------------------------------------------
-%        Potential Energy     
-% -------------------------------------------------------------------------------------------------------------
-%\subsection{Potential Energy anomalies}
-%\label{TRA_bn2}
-
-%    =====>>>>> TO BE written
-%
+where $\alpha$ and $\beta $ are the constant coefficients used to 
+defined the linear equation of state \eqref{Eq_tra_eos_linear}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Specific Heat
+% -------------------------------------------------------------------------------------------------------------
+\subsection   	[Specific Heat (\textit{phycst})]
+			{Specific Heat (\mdl{phycst})}
+\label{TRA_adv_ldf}
+
+The specific heat of sea water, $C_p$, is a function of temperature, salinity 
+and pressure \citep{UNESCO1983}. It is only used in the model to convert 
+surface heat fluxes into surface temperature increase and so the pressure 
+dependence is neglected. The dependence on $T$ and $S$ is weak. 
+For example, with $S=35~psu$, $C_p$ increases from $3989$ to $4002$ 
+when $T$ varies from -2~\degres C to 31~\degres C. Therefore, $C_p$ has 
+been chosen as a constant: $C_p=4.10^3~J\,Kg^{-1}\,\degres K^{-1}$. 
+Its value is set in \mdl{phycst} module. 
+
 
 % -------------------------------------------------------------------------------------------------------------
@@ -1331,5 +1298,5 @@
 sea water ($i.e.$ referenced to the surface $p=0$), thus the pressure dependent 
 terms in \eqref{Eq_tra_eos_fzp} (last term) have been dropped. The freezing
-point is computed through \textit{eos\_fzp}, a \textsc{Fortran} function that can be found 
+point is computed through \textit{tfreez}, a \textsc{Fortran} function that can be found 
 in \mdl{eosbn2}.  
 
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_asminc
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_asminc	(revision 10250)
+++ 	(revision )
@@ -1,18 +1,0 @@
-!-----------------------------------------------------------------------
-&nam_asminc   !   assimilation increments                               ('key_asminc')
-!-----------------------------------------------------------------------
-    ln_bkgwri = .false.    !  Logical switch for writing out background state
-    ln_trainc = .false.    !  Logical switch for applying tracer increments
-    ln_dyninc = .false.    !  Logical switch for applying velocity increments
-    ln_sshinc = .false.    !  Logical switch for applying SSH increments
-    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
-    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
-    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
-    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
-    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
-    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
-    niaufn    = 0          !  Type of IAU weighting function
-    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
-    salfixmin = -9999      !  Minimum salinity after applying the increments
-    nn_divdmp = 0          !  Number of iterations of divergence damping operator
-/
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_diaharm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_diaharm	(revision 10250)
+++ 	(revision )
@@ -1,9 +1,0 @@
-!-----------------------------------------------------------------------
-&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
-!-----------------------------------------------------------------------
-    nit000_han = 1         ! First time step used for harmonic analysis
-    nitend_han = 75        ! Last time step used for harmonic analysis
-    nstep_han  = 15        ! Time step frequency for harmonic analysis
-    tname(1)   = 'M2'      ! Name of tidal constituents
-    tname(2)   = 'K1'
-/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_dmp_create
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_dmp_create	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_dmp_create	(revision 10251)
@@ -0,0 +1,23 @@
+&nam_dmp_create
+    cp_cfg = 'orca'            ! Name of model grid (orca and C1D have special options 
+                               ! otherwise ignored)
+    cp_cfz = 'antarctic'       ! Name of zoom configuration (arctic and antarctic have 
+                               ! some special treatment if lzoom=.true.)
+    jp_cfg = 2                 ! Resolution of the model (used for med_red_seas damping)
+    lzoom = .false.            ! Zoom configuration or not
+    ln_full_field = .false.    ! Calculate coefficient over whole of domain
+    ln_med_red_seas = .true.   ! Damping in Med/Red Seas 
+                               ! (or local modifications here if ln_full_field=.true.)
+    ln_old_31_lev_code = .true.   ! Replicate behaviour of old online code for 31 level model 
+                                  ! (Med/Red seas damping based on level number instead of depth)
+    ln_coast = .true.          ! Reduce near to coastlines
+    ln_zero_top_layer = .true. ! No damping in top layer
+    ln_custom = .false.        ! Call "custom" module to apply user modifications to the 
+                               ! damping coefficient field
+    pn_surf = 0.25             ! Surface Relaxation timescale (days)
+    pn_bot = 0.25              ! Bottom relaxation timescale (days)
+    pn_dep = 1000              ! Transition depth from upper to deep ocean
+    nn_hdmp = 10               ! Damp poleward of this latitude (smooth transition up to maximum damping)
+    jperio = 2                 ! Lateral boundary condition (as specified in namelist_cfg for model run).
+/
+
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_tide
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_tide	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_tide	(revision 10251)
@@ -3,6 +3,14 @@
 !-----------------------------------------------------------------------
    ln_tide_pot   = .true.   !  use tidal potential forcing
-   ln_tide_ramp  = .false.  !
-   rdttideramp   =    0.    !
-   clname(1)     = 'DUMMY'  !  name of constituent - all tidal components must be set in namelist_cfg
+   clname(1)     =   'M2'   !  name of constituent
+   clname(2)     =   'S2'
+   clname(3)     =   'N2'
+   clname(4)     =   'K1'
+   clname(5)     =   'O1'
+   clname(6)     =   'Q1'
+   clname(7)     =   'M4'
+   clname(8)     =   'K2'
+   clname(9)     =   'P1'
+   clname(10)    =   'Mf'
+   clname(11)    =   'Mm'
 /
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_vvl
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nam_vvl	(revision 10250)
+++ 	(revision )
@@ -1,14 +1,0 @@
-!-----------------------------------------------------------------------
-&nam_vvl    !   vertical coordinate options
-!-----------------------------------------------------------------------
-   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
-   ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations
-   ln_vvl_layer  = .false.          !  full layer vertical coordinate
-   ln_vvl_ztilde_as_zstar = .false. !  ztilde vertical coordinate emulating zstar
-   ln_vvl_zstar_at_eqtor = .false.  !  ztilde near the equator
-   rn_ahe3       = 0.0e0            !  thickness diffusion coefficient
-   rn_rst_e3t    = 30.e0            !  ztilde to zstar restoration timescale [days]
-   rn_lf_cutoff  = 5.0e0            !  cutoff frequency for low-pass filter  [days]
-   rn_zdef_max   = 0.9e0            !  maximum fractional e3t deformation
-   ln_vvl_dbg    = .true.           !  debug prints    (T/F)
-/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namasm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namasm	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namasm	(revision 10251)
@@ -0,0 +1,18 @@
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambbc
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambbc	(revision 10250)
+++ 	(revision )
@@ -1,16 +1,0 @@
-!-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-!              !                              !  (if <0  months)  !  
-!              !  file name      ! frequency (hours) ! variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !                 !  (if <0  months)  !   name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_qgh      ='geothermal_heating.nc',  -12.  , 'heatflow'      ,   .false.      , .true.  , 'yearly'  , ''       , ''       , ''
-   !
-   cn_dir      = './'      !  root directory for the location of the runoff files
-   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
-   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux
-                           !     = 1 constant flux
-                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2)
-   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
-
-/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy	(revision 10251)
@@ -2,33 +2,22 @@
 &nambdy        !  unstructured open boundaries                          ("key_bdy")
 !-----------------------------------------------------------------------
-    nb_bdy         = 0                    !  number of open boundary sets
+    nb_bdy = 1                            !  number of open boundary sets
     ln_coords_file = .true.               !  =T : read bdy coordinates from file
     cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
-    ln_mask_file   = .false.              !  =T : read mask from file
-    cn_mask_file   = ''                   !  name of mask file (if ln_mask_file=.TRUE.)
-    cn_dyn2d       = 'none'               !
-    nn_dyn2d_dta   =  0                   !  = 0, bdy data are equal to the initial state
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
                                           !  = 1, bdy data are read in 'bdydata   .nc' files
                                           !  = 2, use tidal harmonic forcing data from files
                                           !  = 3, use external data AND tidal harmonic forcing
-    cn_dyn3d      =  'none'               !
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
     nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    cn_tra        =  'none'               !
-    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    cn_ice_lim      =  'none'             !
-    nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice
-    rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           --
-    rn_ice_age      = 30.                 !  lim3 only:      --   age                --
-
-    ln_tra_dmp    =.false.                !  open boudaries conditions for tracers
-    ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities
-    rn_time_dmp   =  1.                   ! Damping time scale in days
-    rn_time_dmp_out =  1.                 ! Outflow damping time scale
-    nn_rimwidth   = 10                    !  width of the relaxation zone
-    ln_vol        = .false.               !  total volume correction (see nn_volctl parameter)
-    nn_volctl     = 1                     !  = 0, the total water flux across open boundaries is zero
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_dta
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_dta	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_dta	(revision 10251)
@@ -2,21 +2,13 @@
 &nambdy_dta      !  open boundaries - external data           ("key_bdy")
 !-----------------------------------------------------------------------
-!              !  file name      ! frequency (hours) ! variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !                 !  (if <0  months)  !   name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
-   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-! for lim2
-!   bn_frld  =    'amm12_bdyT_ice' ,         24        , 'ileadfra' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-!   bn_hicif =    'amm12_bdyT_ice' ,         24        , 'iicethic' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-!   bn_hsnif =    'amm12_bdyT_ice' ,         24        , 'isnowthi' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-! for lim3
-!   bn_a_i  =    'amm12_bdyT_ice' ,         24        , 'ileadfra' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-!   bn_ht_i =    'amm12_bdyT_ice' ,         24        , 'iicethic' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
-!   bn_ht_s =    'amm12_bdyT_ice' ,         24        , 'isnowthi' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , ''
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! filename      !
+   bn_ssh =     'amm12_bdyT_u2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''    , ''
+   bn_u2d =     'amm12_bdyU_u2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''    , ''
+   bn_v2d =     'amm12_bdyV_u2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''    , ''
+   bn_u3d  =    'amm12_bdyU_u3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''    , ''
+   bn_v3d  =    'amm12_bdyV_u3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''    , ''
+   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''    , ''
+   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''    , ''
    cn_dir  =    'bdydta/'
    ln_full_vel = .false.
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_dta2
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_dta2	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_dta2	(revision 10251)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! filename      !
+   bn_tem  =    'amm12_bdyT_clim' ,         -1        , 'votemper' ,     .true.     , .true. ,  'daily'  ,    ''    ,   ''    , ''
+   bn_sal  =    'amm12_bdyT_clim' ,         -1        , 'vosaline' ,     .true.     , .true. ,  'daily'  ,    ''    ,   ''    , ''
+   cn_dir  =    'bdydta/'
+   ln_full_vel = .false.
+/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_index
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_index	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nambdy_index	(revision 10251)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&nambdy_index    !  open boundaries - definition           ("key_bdy")
+!-----------------------------------------------------------------------
+    nbdysege = 0
+    nbdysegw = 1
+    jpiwob = 2
+    jpjwdt = 2
+    jpjwft = 191
+    nbdysegn = 1
+    jpjnob = 191
+    jpindt = 2
+    jpinft = 146
+    nbdysegs = 1
+    jpjsob = 2
+    jpisdt = 2
+    jpisft = 43
+/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namberg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namberg	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namberg	(revision 10251)
@@ -9,8 +9,8 @@
                                                       ! Initial mass required for an iceberg of each class
       rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11
-                                                      ! Proportion of calving mass to apportion to each class
+                                                      ! Proportion of calving mass to apportion to each class  
       rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02
                                                       ! Ratio between effective and real iceberg mass (non-dim)
-                                                      ! i.e. number of icebergs represented at a point
+                                                      ! i.e. number of icebergs represented at a point         
       rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
                                                       ! thickness of newly calved bergs (m)
@@ -21,14 +21,14 @@
       rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits
       rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1)
-      ln_passive_mode          = .false.              ! iceberg - ocean decoupling
+      ln_passive_mode          = .false.              ! iceberg - ocean decoupling   
       nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no)
                                                       ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2)
       rn_test_box              = 108.0,  116.0, -66.0, -58.0
-      rn_speed_limit           = 0.                   ! CFL speed limit for a berg
+      rn_speed_limit           = 0.                   ! CFL speed limit for a berg   
 
-!              ! file name ! frequency (hours) !   variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !           !  (if <0  months)  !     name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
-      sn_icb =  'calving' ,       -1           , 'calvingmask',  .true.        , .true.  , 'yearly'  , ''       , ''       , ''
-
-      cn_dir = './'
+               ! filename ! freq (hours) ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! land/sea mask !
+               !          ! (<0  months) !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! filename      !
+      sn_icb =  'calving' ,     -1       , 'calvingmask',  .true.      , .true., 'yearly'   , ' '      , ' '  , ''
+   
+      cn_dir = './' 
 /
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namc1d
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namc1d	(revision 10250)
+++ 	(revision )
@@ -1,7 +1,0 @@
-!-----------------------------------------------------------------------
-&namc1d        !   1D configuration options                             ("key_c1d")
-!-----------------------------------------------------------------------
-   rn_lat1d    =      50   !  Column latitude (default at PAPA station)
-   rn_lon1d    =    -145   !  Column longitude (default at PAPA station)
-   ln_c1d_locpt=  .true.   ! Localization of 1D config in a grid (T) or independant point (F)
-/
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namc1d_dyndmp
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namc1d_dyndmp	(revision 10250)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!-----------------------------------------------------------------------
-&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
-!-----------------------------------------------------------------------
-   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F)
-/
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namc1d_uvd
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namc1d_uvd	(revision 10250)
+++ 	(revision )
@@ -1,12 +1,0 @@
-!-----------------------------------------------------------------------
-&namc1d_uvd    !   data: U & V currents                                 ("key_c1d")
-!-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_ucur     = 'ucurrent'  ,         -1        ,'u_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Ume'   , ''
-   sn_vcur     = 'vcurrent'  ,         -1        ,'v_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Vme'   , ''
-!
-   cn_dir        = './'    !  root directory for the location of the files
-   ln_uvd_init   = .false. !  Initialisation of ocean U & V with U & V input data (T) or not (F)
-   ln_uvd_dyndmp = .false. !  damping of ocean U & V toward U & V input data (T) or not (F)
-/
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namcfg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namcfg	(revision 10250)
+++ 	(revision )
@@ -1,22 +1,0 @@
-!-----------------------------------------------------------------------
-&namcfg     !   parameters of the configuration
-!-----------------------------------------------------------------------
-   cp_cfg      =  "default"            !  name of the configuration
-   cp_cfz      =  "no zoom"            !  name of the zoom of configuration
-   jp_cfg      =       0               !  resolution of the configuration
-   jpidta      =      10               !  1st lateral dimension ( >= jpi )
-   jpjdta      =      12               !  2nd    "         "    ( >= jpj )
-   jpkdta      =      31               !  number of levels      ( >= jpk )
-   jpiglo      =      10               !  1st dimension of global domain --> i =jpidta
-   jpjglo      =      12               !  2nd    -                  -    --> j =jpjdta
-   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
-   jpjzoom     =       1               !  in data domain indices
-   jperio      =       0               !  lateral cond. type (between 0 and 6)
-                                       !  = 0 closed                 ;   = 1 cyclic East-West
-                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
-                                       !  = 4 cyclic East-West AND North fold T-point pivot
-                                       !  = 5 North fold F-point pivot
-                                       !  = 6 cyclic East-West AND North fold F-point pivot
-   ln_use_jattr = .false.              !  use (T) the file attribute: open_ocean_jstart, if present
-                                       !  in netcdf input files, as the start j-row for reading
-/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namcfg_orca1
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namcfg_orca1	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namcfg_orca1	(revision 10251)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       1               !  resolution of the configuration
+   jpidta      =     362               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+   ln_use_jattr = .true.               !  use (T) the file attribute: open_ocean_jstart if present
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namcrs
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namcrs	(revision 10250)
+++ 	(revision )
@@ -1,16 +1,0 @@
-!-----------------------------------------------------------------------
-&namcrs        !   Grid coarsening for dynamics output and/or
-               !   passive tracer coarsened online simulations
-!-----------------------------------------------------------------------
-   nn_factx    = 3         !  Reduction factor of x-direction
-   nn_facty    = 3         !  Reduction factor of y-direction
-   nn_binref   = 0         !  Bin centering preference: NORTH or EQUAT
-                           !  0, coarse grid is binned with preferential treatment of the north fold
-                           !  1, coarse grid is binned with centering at the equator
-                           !    Symmetry with nn_facty being odd-numbered. Asymmetry with even-numbered nn_facty.
-   nn_msh_crs  = 1         !  create (=1) a mesh file or not (=0)
-   nn_crs_kz   = 0         ! 0, MEAN of volume boxes
-                           ! 1, MAX of boxes
-                           ! 2, MIN of boxes
-   ln_crs_wn   = .true.    ! wn coarsened (T) or computed using horizontal divergence ( F )
-/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdia_harm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdia_harm	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdia_harm	(revision 10251)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
+!-----------------------------------------------------------------------
+    nit000_han = 1         ! First time step used for harmonic analysis
+    nitend_han = 75        ! Last time step used for harmonic analysis
+    nstep_han  = 15        ! Time step frequency for harmonic analysis
+    tname(1)   = 'M2'      ! Name of tidal constituents
+    tname(2)   = 'K1'
+/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdom
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdom	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdom	(revision 10251)
@@ -3,7 +3,6 @@
 !-----------------------------------------------------------------------
    nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
-   rn_bathy    =    0.     !  value of the bathymetry. if (=0) bottom flat at jpkm1
-   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
-   nn_msh      =    1      !  create (=1) a mesh file or not (=0)
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
    rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
    rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
@@ -17,5 +16,4 @@
    rn_rdtmax   = 28800.          !  maximum time step on tracers (used if nn_acc=1)
    rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
-   ln_crs      = .false.      !  Logical switch for coarsening module
    jphgr_msh   =       0               !  type of horizontal mesh
                                        !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_adv
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_adv	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_adv	(revision 10251)
@@ -2,8 +2,6 @@
 &namdyn_adv    !   formulation of the momentum advection
 !-----------------------------------------------------------------------
-   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
-   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
    ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
-   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
-   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
-/
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_hpg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_hpg	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_hpg	(revision 10251)
@@ -5,5 +5,5 @@
    ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
    ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
-   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to isf
+   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to ice shelf cavity
    ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
    ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_vor
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_vor	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namdyn_vor	(revision 10251)
@@ -6,4 +6,3 @@
    ln_dynvor_mix = .false. !  mixed scheme
    ln_dynvor_een = .true.  !  energy & enstrophy scheme
-   ln_dynvor_een_old = .false.  !  energy & enstrophy scheme - original formulation
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nameos
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nameos	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nameos	(revision 10251)
@@ -2,18 +2,9 @@
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
-   nn_eos      =  -1     !  type of equation of state and Brunt-Vaisala frequency
-                                 !  =-1, TEOS-10
-                                 !  = 0, EOS-80
-                                 !  = 1, S-EOS   (simplified eos)
-   ln_useCT    = .true.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm
-   !                             !
-   !                     ! S-EOS coefficients :
-   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
-   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1)
-   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1)
-   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos)
-   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos)
-   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos)
-   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos)
-   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos)
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namhsb
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namhsb	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namhsb	(revision 10251)
@@ -1,4 +1,4 @@
 !-----------------------------------------------------------------------
-&namhsb       !  Heat and salt budgets
+&namhsb       !  Heat and salt budgets 
 !-----------------------------------------------------------------------
    ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nammpp_dyndist
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nammpp_dyndist	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/nammpp_dyndist	(revision 10251)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
+!-----------------------------------------------------------------------
+   jpni        =    1      !  jpni   number of processors following i
+   jpnj        =    1      !  jpnj   number of processors following j
+   jpnij       =    1      !  jpnij  number of local domains
+/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namobs
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namobs	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namobs	(revision 10251)
@@ -5,52 +5,58 @@
    ln_s3d     = .false.    ! Logical switch for S profile observations
    ln_ena     = .false.    ! Logical switch for ENACT insitu data set
-   ln_cor     = .false.    ! Logical switch for Coriolis insitu data set
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set
    ln_profb   = .false.    ! Logical switch for feedback insitu data set
    ln_sla     = .false.    ! Logical switch for SLA observations
+
    ln_sladt   = .false.    ! Logical switch for AVISO SLA data
+
    ln_slafb   = .false.    ! Logical switch for feedback SLA data
-   ln_ssh     = .false.    ! Logical switch for SSH observations
-   ln_sst     = .false.    ! Logical switch for SST observations
-   ln_reysst  = .false.    ! Logical switch for Reynolds observations
-   ln_ghrsst  = .false.    ! Logical switch for GHRSST observations
+                           !     ln_ssh                  Logical switch for SSH observations
+
+   ln_sst     = .true.     ! Logical switch for SST observations
+   ln_reysst  = .true.     !     ln_reysst               Logical switch for Reynolds observations
+   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations      
+
    ln_sstfb   = .false.    ! Logical switch for feedback SST data
-   ln_sss     = .false.    ! Logical switch for SSS observations
-   ln_seaice  = .false.    ! Logical switch for Sea Ice observations
-   ln_vel3d   = .false.    ! Logical switch for velocity observations
-   ln_velavcur= .false     ! Logical switch for velocity daily av. cur.
-   ln_velhrcur= .false     ! Logical switch for velocity high freq. cur.
-   ln_velavadcp = .false.  ! Logical switch for velocity daily av. ADCP
-   ln_velhradcp = .false.  ! Logical switch for velocity high freq. ADCP
-   ln_velfb   = .false.    ! Logical switch for feedback velocity data
-   ln_grid_global = .false. ! Global distribtion of observations
-   ln_grid_search_lookup = .false. !  Logical switch for obs grid search w/lookup table
-   grid_search_file = 'grid_search'  !  Grid search lookup file header
-! All of the *files* variables below are arrays. Use namelist_cfg to add more files
-   enactfiles = 'enact.nc' !  ENACT input observation file names (specify full array in namelist_cfg)
-   coriofiles = 'corio.nc' !  Coriolis input observation file name
-   profbfiles = 'profiles_01.nc' ! Profile feedback input observation file name
-   ln_profb_enatim = .false !        Enact feedback input time setting switch
-   slafilesact = 'sla_act.nc' !  Active SLA input observation file names
-   slafilespas = 'sla_pass.nc' ! Passive SLA input observation file names
-   slafbfiles = 'sla_01.nc' ! slafbfiles: Feedback SLA input observation file names
-   sstfiles = 'ghrsst.nc'   ! GHRSST input observation file names
-   sstfbfiles = 'sst_01.nc' ! Feedback SST input observation file names
-   seaicefiles = 'seaice_01.nc' ! Sea Ice input observation file names
-   velavcurfiles = 'velavcurfile.nc'  ! Vel. cur. daily av. input file name
-   velhrcurfiles = 'velhrcurfile.nc'  ! Vel. cur. high freq. input file name
-   velavadcpfiles = 'velavadcpfile.nc' ! Vel. ADCP daily av. input file name
-   velhradcpfiles = 'velhradcpfile.nc' ! Vel. ADCP high freq. input file name
-   velfbfiles = 'velfbfile.nc' ! Vel. feedback input observation file name
-   dobsini = 20000101.000000  !  Initial date in window YYYYMMDD.HHMMSS
-   dobsend = 20010101.000000  !  Final date in window YYYYMMDD.HHMMSS
-   n1dint = 0  !               Type of vertical interpolation method
-   n2dint = 0  !               Type of horizontal interpolation method
-   ln_nea = .false.   !        Rejection of observations near land switch
-   nmsshc     = 0     !        MSSH correction scheme
-   mdtcorr = 1.61     !        MDT  correction
-   mdtcutoff = 65.0   !        MDT cutoff for computed correction
+                           !     ln_sss                  Logical switch for SSS observations
+                           !     ln_seaice               Logical switch for Sea Ice observations
+                           !     ln_vel3d                Logical switch for velocity observations
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data
+                           !     ln_grid_global          Global distribtion of observations
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table
+                           !     grid_search_file        Grid search lookup file header
+                           !     enactfiles              ENACT input observation file names
+                           !     coriofiles              Coriolis input observation file name
+   !                       ! profbfiles: Profile feedback input observation file name
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name
+   !                       ! slafbfiles: Feedback SLA input observation file name
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name
+   !                       ! sstfbfiles: Feedback SST input observation file name
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name
+                           !     velavcurfiles           Vel. cur. daily av. input file name
+                           !     velhvcurfiles           Vel. cur. high freq. input file name
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name
+                           !     velfbfiles              Vel. feedback input observation file name
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS
+                           !     n1dint                  Type of vertical interpolation method
+                           !     n2dint                  Type of horizontal interpolation method
+                           !     ln_nea                  Rejection of observations near land switch
+   nmsshc     = 0          ! MSSH correction scheme
+                           !     mdtcorr                 MDT  correction
+                           !     mdtcutoff               MDT cutoff for computed correction
    ln_altbias = .false.    ! Logical switch for alt bias
    ln_ignmis  = .true.     ! Logical switch for ignoring missing files
-   endailyavtypes = 820    ! ENACT daily average types - array (use namelist_cfg to set more values)
+                           !     endailyavtypes   ENACT daily average types
    ln_grid_global = .true.
    ln_grid_search_lookup = .false.
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namobs_example
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namobs_example	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namobs_example	(revision 10251)
@@ -0,0 +1,63 @@
+!-----------------------------------------------------------------------
+!       namobs    observation usage switch
+!-----------------------------------------------------------------------
+!
+!  ln_t3d                  Logical switch for T profile observations         
+!  ln_s3d                  Logical switch for S profile observations          
+!  ln_ena                  Logical switch for ENACT insitu data set           
+!  ln_cor                  Logical switch for Coriolis insitu data set       
+!  ln_profb                Logical switch for feedback insitu data set     
+!  ln_sla                  Logical switch for SLA observations               
+!  ln_sladt                Logical switch for AVISO SLA data              
+!  ln_slafb                Logical switch for feedback SLA data            
+!  ln_ssh                  Logical switch for SSH observations              
+!  ln_sst                  Logical switch for SST observations              
+!  ln_reysst               Logical switch for Reynolds observations       
+!  ln_ghrsst               Logical switch for GHRSST observations          
+!  ln_sstfb                Logical switch for feedback SST data          
+!  ln_sss                  Logical switch for SSS observations              
+!  ln_seaice               Logical switch for Sea Ice observations        
+!  ln_vel3d                Logical switch for velocity observations         
+!  ln_velavcur             Logical switch for velocity daily av. cur.    
+!  ln_velhrcur             Logical switch for velocity high freq. cur.   
+!  ln_velavadcp            Logical switch for velocity daily av. ADCP  
+!  ln_velhradcp            Logical switch for velocity high freq. ADCP
+!  ln_velfb                Logical switch for feedback velocity data       
+!  ln_grid_global          Global distribtion of observations         
+!  ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+!  grid_search_file        Grid search lookup file header 
+!  enactfiles              ENACT input observation file names 
+!  coriofiles              Coriolis input observation file name  
+!  profbfiles              Profile feedback input observation file name 
+!  ln_profb_enatim         Enact feedback input time setting switch    
+!  slafilesact             Active SLA input observation file name
+!  slafilespas             Passive SLA input observation file name 
+!  slafbfiles              Feedback SLA input observation file name 
+!  sstfiles                GHRSST input observation file name       
+!  sstfbfiles              Feedback SST input observation file name 
+!  seaicefiles             Sea Ice input observation file name 
+!  velavcurfiles           Vel. cur. daily av. input file name  
+!  velhvcurfiles           Vel. cur. high freq. input file name  
+!  velavadcpfiles          Vel. ADCP daily av. input file name    
+!  velhvadcpfiles          Vel. ADCP high freq. input file name 
+!  velfbfiles              Vel. feedback input observation file name 
+!  dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+!  dobsend                 Final date in window YYYYMMDD.HHMMSS         
+!  n1dint                  Type of vertical interpolation method        
+!  n2dint                  Type of horizontal interpolation method       
+!  ln_nea                  Rejection of observations near land switch    
+!  nmsshc                  MSSH correction scheme                         
+!  mdtcorr                 MDT  correction                               
+!  mdtcutoff               MDT cutoff for computed correction          
+!  ln_altbias              Logical switch for alt bias                
+!  ln_ignmis               Logical switch for ignoring missing files   
+!  endailyavtypes          ENACT daily average types                    
+ &namobs
+   ln_t3d = .true.
+   ln_s3d = .true.
+   ln_ena = .true.
+   enactfiles = 'enact.1.nc'
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .true.
+   ln_ignmis = .true.  
+/ 
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namptr
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namptr	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namptr	(revision 10251)
@@ -3,4 +3,9 @@
 !-----------------------------------------------------------------------
    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
-   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namrun
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namrun	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namrun	(revision 10251)
@@ -9,21 +9,15 @@
    nn_leapy    =       0   !  Leap year calendar (1) or not (0)
    ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
-   nn_euler    =       1   !  = 0 : start with forward time step if ln_rstart=T
-   nn_rstctl   =       0   !  restart control ==> activated only if ln_rstart=T
+   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T
                            !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
                            !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart
                            !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart
    cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
-   cn_ocerst_indir = "."       !  directory from which to read input ocean restarts
    cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
-   cn_ocerst_outdir = "."      !  directory in which to write output ocean restarts
    nn_istate   =       0   !  output the initial state (1) or not (0)
-   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
    nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
-   nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written
    nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
    ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
    ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
-   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard
    ln_clobber  = .false.   !  clobber (overwrite) an existing file
    nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc	(revision 10251)
@@ -9,19 +9,14 @@
    ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)
    ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
-   ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 )
-   ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 )
-   nn_components = 0       !  configuration of the opa-sas OASIS coupling
-                           !  =0 no opa-sas OASIS coupling: default single executable configuration
-                           !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component
-                           !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component 
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
    ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
    nn_ice      = 2         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                         ("key_lim3" or "key_lim2")
-   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
                            !  =1 levitating ice with mass and salt exchange but no presure effect
                            !  =2 embedded sea-ice (full salt and mass exchanges and pressure)
    ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
-   ln_rnf      = .true.    !  runoffs                                   (T   => fill namsbc_rnf)
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
    nn_isf      = 0         !  ice shelf melting/freezing                (/=0 => fill namsbc_isf)
                            !  0 =no isf                  1 = presence of ISF
@@ -30,16 +25,13 @@
                            !  option 1 and 4 need ln_isfcav = .true. (domzgr)
    ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
-   nn_fwb      = 2         !  FreshWater Budget: =0 unchecked
+   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked
                            !     =1 global mean of e-p-r set to zero at each time step
                            !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
    ln_wave = .false.       !  Activate coupling with wave (either Stokes Drift or Drag coefficient, or both)  (T => fill namsbc_wave)
    ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave)
    ln_sdw  = .false.       !  Computation of 3D stokes drift                (T => fill namsbc_wave)
-   nn_lsm  = 0             !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) ,
-                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field)
-   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used)
-                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled
-                           !  = 0  Average per-category fluxes (forced and coupled mode)
-                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled
-                           !  = 2  Redistribute a single flux over categories (coupled mode only)
+   nn_lsm  = 0             !  =0   land/sea mask for input fields is not applied (the field land/sea mask filename
+                           !       is left empty in namelist)  ,
+                           !  =1:n number of iterations of land/sea mask application for input fields
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_apr
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_apr	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_apr	(revision 10251)
@@ -2,10 +2,10 @@
 &namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
 !-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_apr      = 'patm'      ,         -1        ,'somslpre',    .true.     , .true. , 'yearly'  ,  ''      ,   ''     , ''
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''     , ''
 
    cn_dir      = './'       !  root directory for the location of the bulk files
-   rn_pref     = 101000.    !  reference atmospheric pressure   [N/m2]/
+   rn_pref     = 101000._wp !  reference atmospheric pressure   [N/m2]/
    ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F)
    ln_apr_obc  = .false.    !  inverse barometer added to OBC ssh data
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_core
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_core	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_core	(revision 10251)
@@ -2,23 +2,19 @@
 &namsbc_core   !   namsbc_core  CORE bulk formulae
 !-----------------------------------------------------------------------
-!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                               ! rotation ! land/sea mask !
-!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                              ! pairing  ! filename      !
-   sn_wndi     = 'u_10.15JUNE2009_fill'        ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Uwnd'   , ''
-   sn_wndj     = 'v_10.15JUNE2009_fill'        ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Vwnd'   , ''
-   sn_qsr      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
-   sn_qlw      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
-   sn_tair     = 't_10.15JUNE2009_fill'        ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
-   sn_humi     = 'q_10.15JUNE2009_fill'        ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
-   sn_prec     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
-   sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
-   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
-
+!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !  filename     !
+   sn_wndi     = 'u_10.15JUNE2009_orca2'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'   , ''
+   sn_wndj     = 'v_10.15JUNE2009_orca2'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'   , ''
+   sn_qsr      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_orca2'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_orca2'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+!
    cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
    ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
-   rn_zqt      = 10.        !  Air temperature and humidity reference height (m)
-   rn_zu       = 10.        !  Wind vector reference height (m)
    rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
-   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
-   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
-                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_cpl
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_cpl	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_cpl	(revision 10251)
@@ -1,27 +1,23 @@
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
 !-----------------------------------------------------------------------
 !                    !     description       !  multiple  !    vector   !      vector          ! vector !
 !                    !                       ! categories !  reference  !    orientation       ! grids  !
 ! send
-   sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''
-   sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''
-   sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''
-   sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'
-   sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''
+sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''
+sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''
+sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   ''
+sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'
+sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''
 ! receive
-   sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
-   sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
-   sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'
-   sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
-   sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
-   sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
-   sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''
-   sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
-   sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
-   sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
-!
-   nn_cplmodel   =     1     !  Maximum number of models to/from which NEMO is potentialy sending/receiving data
-   ln_usecplmask = .false.   !  use a coupling mask file to merge data received from several models
-                             !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
+sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'
+sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
+sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
+sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''
+sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_mfs
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_mfs	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_mfs	(revision 10251)
@@ -2,14 +2,13 @@
 &namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
 !-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights     ! rotation ! land/sea mask !
-!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename    ! pairing  ! filename      !
-   sn_wndi     =   'ecmwf'   ,        6          , 'u10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''       , ''
-   sn_wndj     =   'ecmwf'   ,        6          , 'v10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''       , ''
-   sn_clc      =   'ecmwf'   ,        6          , 'clc'     ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''       , ''
-   sn_msl      =   'ecmwf'   ,        6          , 'msl'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''       , ''
-   sn_tair     =   'ecmwf'   ,        6          , 't2'      ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''       , ''
-   sn_rhm      =   'ecmwf'   ,        6          , 'rh'      ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''       , ''
-   sn_prec     =   'ecmwf'   ,        6          , 'precip'  ,    .true.    , .true.  , 'daily'  ,'bicubic.nc' , ''       , ''
-
-   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_wndi     =   'ecmwf'   ,        6          , 'u10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''    , ''
+   sn_wndj     =   'ecmwf'   ,        6          , 'v10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''    , ''
+   sn_clc      =   'ecmwf'   ,        6          , 'clc'     ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''    , ''
+   sn_msl      =   'ecmwf'   ,        6          , 'msl'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''    , ''
+   sn_tair     =   'ecmwf'   ,        6          , 't2'      ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''    , ''
+   sn_rhm      =   'ecmwf'   ,        6          , 'rh'      ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''    , ''
+   sn_prec     =   'precip'  ,        6          , 'precip'  ,    .true.    , .false. , 'daily'  ,'bicubic'    , ''    , ''
+   cn_dir      =   './'      !  root directory for the location of the bulk files
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_rnf
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_rnf	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_rnf	(revision 10251)
@@ -2,13 +2,14 @@
 &namsbc_rnf    !   runoffs namelist surface boundary condition
 !-----------------------------------------------------------------------
-!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
-   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
-   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
-   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
-   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
 
    cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
    ln_rnf_mouth = .true.    !  specific treatment at rivers mouths
    rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
@@ -18,7 +19,3 @@
    ln_rnf_tem   = .false.   !  read in temperature information for runoff
    ln_rnf_sal   = .false.   !  read in salinity information for runoff
-   ln_rnf_depth_ini = .false.  ! compute depth at initialisation from runoff file
-   rn_rnf_max   = 5.735e-4  !  max value of the runoff climatologie over global domain ( ln_rnf_depth_ini = .true )
-   rn_dep_max   = 150.      !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
-   nn_rnf_depth_file = 0    !  create (=1) a runoff depth file or not (=0)
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_sas
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_sas	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_sas	(revision 10251)
@@ -4,14 +4,11 @@
 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_usp      = 'sas_grid_U' ,    120           , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
-   sn_vsp      = 'sas_grid_V' ,    120           , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
-   sn_tem      = 'sas_grid_T' ,    120           , 'sosstsst' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
-   sn_sal      = 'sas_grid_T' ,    120           , 'sosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
-   sn_ssh      = 'sas_grid_T' ,    120           , 'sossheig' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
-   sn_e3t      = 'sas_grid_T' ,    120           , 'e3t_m'    ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
-   sn_frq      = 'sas_grid_T' ,    120           , 'frq_m'    ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
+   sn_usp      = 'sas_grid_U' ,    120    , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
+   sn_vsp      = 'sas_grid_V' ,    120    , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
+   sn_tem      = 'sas_grid_T' ,    120    , 'sosstsst' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
+   sn_sal      = 'sas_grid_T' ,    120    , 'sosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
+   sn_ssh      = 'sas_grid_T' ,    120    , 'sossheig' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
 
-   ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field
-   ln_read_frq = .false.    !  specify whether we must read frq or not
+   ln_3d_uv    = .true.    !  specify whether we are supplying a 3D u,v field
    cn_dir      = './'      !  root directory for the location of the bulk files are
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_wave
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_wave	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsbc_wave	(revision 10251)
@@ -2,10 +2,10 @@
 &namsbc_wave   ! External fields from wave model
 !-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable     ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !             !  (if <0  months)  !   name       !   (logical)  !  (T/F)  ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
-   sn_usd      =  'sdw_wave' ,        1          , 'u_sd2d'     ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
-   sn_vsd      =  'sdw_wave' ,        1          , 'v_sd2d'     ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
-   sn_wn       =  'sdw_wave' ,        1          , 'wave_num'   ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.    , .false. , 'daily'  , ''       , ''       , ''
+   sn_usd      =  'sdw_wave' ,        1          , 'u_sd2d'     , .true.   , .false. , 'daily'  ,''         , ''       , ''
+   sn_vsd      =  'sdw_wave' ,        1          , 'v_sd2d'     , .true.   , .false. , 'daily'  ,''         , ''       , ''
+   sn_wn       =  'sdw_wave' ,        1          , 'wave_num'   , .true.   , .false. , 'daily'  ,''         , ''       , ''
 !
    cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsto
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namsto	(revision 10250)
+++ 	(revision )
@@ -1,17 +1,0 @@
-!-----------------------------------------------------------------------
-&namsto       ! Stochastic parametrization of EOS
-!-----------------------------------------------------------------------
-   ln_rststo = .false.           ! start from mean parameter (F) or from restart file (T)
-   ln_rstseed = .true.           ! read seed of RNG from restart file
-   cn_storst_in  = "restart_sto" !  suffix of stochastic parameter restart file (input)
-   cn_storst_out = "restart_sto" !  suffix of stochastic parameter restart file (output)
-
-   ln_sto_eos = .false.          ! stochastic equation of state
-   nn_sto_eos = 1                ! number of independent random walks
-   rn_eos_stdxy = 1.4            ! random walk horz. standard deviation (in grid points)
-   rn_eos_stdz  = 0.7            ! random walk vert. standard deviation (in grid points)
-   rn_eos_tcor  = 1440.0         ! random walk time correlation (in timesteps)
-   nn_eos_ord  = 1               ! order of autoregressive processes
-   nn_eos_flt  = 0               ! passes of Laplacian filter
-   rn_eos_lim  = 2.0             ! limitation factor (default = 3.0)
-/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_adv
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_adv	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_adv	(revision 10251)
@@ -2,11 +2,10 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
-   ln_traadv_cen2   =  .false.   !  2nd order centered scheme
-   ln_traadv_tvd    =  .true.    !  TVD scheme
-   ln_traadv_muscl  =  .false.   !  MUSCL scheme
-   ln_traadv_muscl2 =  .false.   !  MUSCL2 scheme + cen2 at boundaries
-   ln_traadv_ubs    =  .false.   !  UBS scheme
-   ln_traadv_qck    =  .false.   !  QUICKEST scheme
-   ln_traadv_msc_ups=  .false.   !  use upstream scheme within muscl
-   ln_traadv_tvd_zts=  .false.  !  TVD scheme with sub-timestepping of vertical tracer advection
+   ln_traadv_cen2   =  .false.  !  2nd order centered scheme
+   ln_traadv_tvd    =  .true.   !  TVD scheme
+   ln_traadv_muscl  =  .false.  !  MUSCL scheme
+   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
+   ln_traadv_ubs    =  .false.  !  UBS scheme
+   ln_traadv_qck    =  .false.  !  QUICKEST scheme
+   ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl
 /
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_adv_mle
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_adv_mle	(revision 10250)
+++ 	(revision )
@@ -1,13 +1,0 @@
-!-----------------------------------------------------------------------
-&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param)
-!-----------------------------------------------------------------------
-   ln_mle    = .true.      ! (T) use the Mixed Layer Eddy (MLE) parameterisation
-   rn_ce     = 0.06        ! magnitude of the MLE (typical value: 0.06 to 0.08)
-   nn_mle    = 1           ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
-   rn_lf     = 5.e+3       ! typical scale of mixed layer front (meters)                      (case rn_mle=0)
-   rn_time   = 172800.     ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_mle=0)
-   rn_lat    = 20.         ! reference latitude (degrees) of MLE coef.                        (case rn_mle=1)
-   nn_mld_uv = 0           ! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max)
-   nn_conv   = 0           ! =1 no MLE in case of convection ; =0 always MLE
-   rn_rho_c_mle  = 0.01    ! delta rho criterion used to calculate MLD for FK
-/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_bbc
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_bbc	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_bbc	(revision 10251)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2)
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_dmp
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_dmp	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_dmp	(revision 10251)
@@ -2,8 +2,9 @@
 &namtra_dmp    !   tracer: T & S newtonian damping
 !-----------------------------------------------------------------------
-   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
-   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
-                           !                   =1 no damping in the mixing layer (kz  criteria)
-                           !                   =2 no damping in the mixed  layer (rho crieria)
-   cn_resto    = 'resto.nc' ! Name of file containing restoration coefficient field (use dmp_tools to create this)
+   ln_tradmp   =  .true.     !  add a damping termn (T) or not (F)
+   nn_zdmp     =    0        !  vertical   shape =0    damping throughout the water column
+                             !                   =1 no damping in the mixing layer (kz  criteria)
+                             !                   =2 no damping in the mixed  layer (rho crieria)
+   cn_resto    = 'resto.nc'  ! Name of file containing restoration coefficient field (use dmp_tools to create this)
+
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_qsr
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_qsr	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtra_qsr	(revision 10251)
@@ -15,4 +15,3 @@
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
    rn_si1      =   23.0    !  2 bands: longest depth of extinction
-   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtrd
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtrd	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtrd	(revision 10251)
@@ -1,14 +1,12 @@
 !-----------------------------------------------------------------------
-&namtrd        !   diagnostics on dynamics and/or tracer trends
-!              !       and/or mixed-layer trends and/or barotropic vorticity
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
 !-----------------------------------------------------------------------
-   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE
-   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output
-   ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet)
-   ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet)
-   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends
-   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends
-   ln_tra_trd  = .FALSE.   ! (T) 3D tracer trend output
-   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet)
-   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step)
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtsd
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtsd	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namtsd	(revision 10251)
@@ -2,9 +2,8 @@
 &namtsd    !   data : Temperature  & Salinity
 !-----------------------------------------------------------------------
-!-----------------------------------------------------------------------
-!          !  file name                            ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!          !                                       !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_tem  = 'data_1m_potential_temperature_nomask',         -1        ,'votemper' ,    .true.    , .true. , 'yearly'   , ''       ,   ''    ,    ''
-   sn_sal  = 'data_1m_salinity_nomask'             ,         -1        ,'vosaline' ,    .true.    , .true. , 'yearly'   , ''       ,   ''    ,    ''
+!          ! file name ! frequency (hours)         ! variable     ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! land/sea mask !
+!          !           !  (if <0  months)          !   name       !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! filename      !
+   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.      , .true., 'yearly'   , ' '      , ' '      , ''
+   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.      , .true., 'yearly'   , ''       , ' '      , ''
    !
    cn_dir        = './'     !  root directory for the location of the runoff files
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzdf_gls
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzdf_gls	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzdf_gls	(revision 10251)
@@ -2,17 +2,17 @@
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
 !-----------------------------------------------------------------------
-   rn_emin       = 1.e-7   !  minimum value of e   [m2/s2]
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
    rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
    ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
-   rn_clim_galp  = 0.267   !  galperin limit
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
    ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
    rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
    rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
-   rn_hsro       =  0.02   !  Minimum surface roughness
-   rn_frac_hs    =   1.3   !  Fraction of wave height as roughness (if nn_z0_met=2)
-   nn_z0_met     =     2   !  Method for surface roughness computation (0/1/2)
-   nn_bc_surf    =     1   !  surface condition (0/1=Dir/Neum)
-   nn_bc_bot     =     1   !  bottom condition (0/1=Dir/Neum)
-   nn_stab_func  =     2   !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
-   nn_clos       =     1   !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzdf_tke
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzdf_tke	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzdf_tke	(revision 10251)
@@ -21,5 +21,5 @@
                            !        = 1 add a tke source below the ML
                            !        = 2 add a tke source just at the base of the ML
-                           !        = 3 as = 1 applied on HF part of the stress    ("key_oasis3")
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
    rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
    nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
Index: /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzgr_sco
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzgr_sco	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/Namelist/namzgr_sco	(revision 10251)
@@ -13,5 +13,5 @@
                         !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.)
    rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
-   rn_bb       =    0.8    !  stretching with SH94 s-sigma
+   rn_bb       =    0.8    !  stretching with SH94 s-sigma   
                         !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.)
    rn_alpha    =    4.4    !  stretching with SF12 s-sigma
@@ -22,4 +22,4 @@
    rn_zb_b     =   -0.2    !  offset for calculating Zb
                         !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
-   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1)
+   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1) 
 /
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/namcfg_orca1
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/namcfg_orca1	(revision 10250)
+++ 	(revision )
@@ -1,12 +1,0 @@
-!-----------------------------------------------------------------------
-&namcfg        !   parameters of the configuration
-!-----------------------------------------------------------------------
-   cp_cfg      =  "orca"               !  name of the configuration
-   jp_cfg      =       1               !  resolution of the configuration
-   jpidta      =     362               !  1st lateral dimension ( >= jpi )
-   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
-   jpkdta      =      75               !  number of levels      ( >= jpk )
-   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
-   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
-   jperio      =       6               !  lateral cond. type (between 0 and 6)
-   ln_use_jattr = .true.               !  use (T) the file attribute: open_ocean_jstart if present
Index: anches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/namelist_split.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/DOC/TexFiles/namelist_split.sh	(revision 10250)
+++ 	(revision )
@@ -1,247 +1,0 @@
-#! /bin/sh
-#
-#       usage for NEMO doc to create an update of the Namelist directory :
-# 1- delete the existing directory (You can also choose to save it somewhere) 
-#    rm -rf Namelist
-# 2- create the updated Namelist directory from the SHARED/namelist_ref :
-#    ./namelist_split.sh -i ../../NEMOGCM/CONFIG/SHARED/namelist_ref -o Namelist
-#
-# .. _namelist_split.sh:
-#
-# =================
-# namelist_split.sh
-# =================
-#
-# ----------------
-# split a namelist
-# ----------------
-#
-# SYNOPSIS
-# ========
-#
-# .. code-block:: bash
-#
-#    namelist_split.sh -i namelist -o dirout [-n]
-#
-# DESCRIPTION
-# ===========
-#
-# Split a namelist file (NEMO convention syntax) given in parameter
-# into files in a given output directory.
-#
-# .. option:: -i <input file (namelist)>
-# .. option:: -o <output directory>
-# .. option:: -n <numbered output files>
-#
-# Each file of the output directory is named after the *block* it contains.
-#
-# We assume here that the input file is written with this pattern of block:
-#
-# .. parsed-literal::
-#
-#    !---------------
-#    &nameblock
-#    !---------------
-#    var1 = val1
-#    ...
-#    varn = valn
-#    /
-#
-# If ``-n`` option is used, files in the directory output are named after
-# the number of the block it contains and the name of this block. This might
-# be useful to recombine blocks in the same order.
-#
-# EXAMPLES
-# ========
-#
-# To split the namelist NEMO ORCA2_LIM experiment 00 if you are in NEMO
-# working space :
-#
-# .. code-block:: bash
-#
-#    namelist_split.sh -i CONFIG/ORCA2_LIM/EXP00/namelist -o /tmp/EXP00_namelist_split/
-#
-# To split the namelist under data directory with numbered files:
-#
-# .. code-block:: bash
-#
-#    namelist_split.sh -i ./data/namelist -o /tmp/EXP00_namelist_split/ -n
-#
-# Check can be made by concatenation of files in output directory if ``-n``
-# option have been used and comparison with original file :
-#
-# .. code-block:: bash
-#
-#    cat /tmp/EXP00_namelist_split/b???_* > /tmp/EXP00_namelist_rebuild
-#    sdiff -w80 ./data/namelist /tmp/EXP00_namelist_rebuild
-#
-# Output contains lines which are before the first block, after the last
-# block and lines between blocks.
-#
-# EVOLUTIONS
-# ==========
-#
-# $Id$
-#
-# - fplod 2008-08-11T08:56:44Z aedon.locean-ipsl.upmc.fr (Darwin)
-#
-#   * commentaires dans ce fichier en reStructuredText
-#     cf. reStructuredText_ and Docutils_
-#
-# .. _reStructuredText: http://docutils.sourceforge.net/rst.html
-# .. _Docutils: http://docutils.sourceforge.net/
-#
-# - fplod 2008-07-22T12:41:04Z aedon.locean-ipsl.upmc.fr (Darwin)
-#
-#   * creation with test on
-#     http://forge.ipsl.jussieu.fr/nemo/browser/trunk/CONFIG/ORCA2_LIM/EXP00/namelist revision 1151
-#-
-#
-system=$(uname)
-case "${system}" in
-    AIX|IRIX64)
-        echo " www : no specific posix checking"
-    ;;
-    *)
-        set -o posix
-    ;;
-esac
-unset system
-#
-command=$(basename ${0})
-log_date=$(date -u +"%Y%m%dT%H%M%SZ")
-#
-usage=" Usage : ${command} -i namelist -o dirout [-n]"
-#
-# default
-blocknum=0
-#
-minargcount=4
-if [ ${#} -lt ${minargcount} ]
-then
-    echo "eee : not enough arguments"
-    echo "${usage}"
-    exit 1
-fi
-#
-while [ ${#} -gt 0 ]
-do
-    case ${1} in
-        -i)
-            filein=${2}
-            shift
-        ;;
-        -o)
-            dirout=${2}
-            shift
-        ;;
-        -h)
-            echo "${usage}"
-            exit 0
-        ;;
-        -n)
-            blocknum=1
-        ;;
-        *)
-            # anything else
-            echo "eee : unknown option ${1}"
-            echo "eee : ${usage}"
-            exit 1
-        ;;
-    esac
-    # next flag
-    shift
-done
-unset usage
-#
-set -u
-#
-# check for filein
-if [ ! -r ${filein} ]
-then
-    echo "eee : ${filein} not accessible"
-    exit 1
-fi
-#
-# check for dirout
-# the idea is to prevent unwanted overwrite
-if [ -d ${dirout} ]
-then
-    echo "eee : ${dirout} already exist"
-    exit 1
-else
-    mkdir -p ${dirout}
-    if [ ${?} -ne 0 ]
-    then
-        echo "eee : cannot create ${dirout}"
-        exit 1
-    fi
-fi
-#
-# loop on each line of ${filein} ie the namelist to be split
-fileout=/dev/null
-begin=0
-if [ ${blocknum} -eq 1 ]
-then
-    iblock=0
-fi
-nbline=$(wc -l ${filein} | awk '{print $1}')
-il=1
-while [ ${il} -le ${nbline} ]
-do
-    line=$(sed -ne "${il},${il}p" ${filein})
-    # if current line start with "&", we can establish the name of output file
-    echo ${line} | grep -q "^&"
-    if [ ${?} -eq 0 ]
-    then
-        begin=1
-        # the form of this line is "&block   !"
-        block=${line#&}
-        block=${block%% *}
-        echo "iii : detection of the beginning of ${block}"
-        if [ ${blocknum} -eq 1 ]
-        then
-            iblock=$(( ${iblock} + 1))
-            fileout=${dirout}/b$(echo ${iblock} | awk '{printf "%3.3d", $1}')_${block}
-        else
-            fileout="${dirout}/${block}"
-        fi
-        # check for ${fileout}
-        if [ -f ${fileout} ]
-        then
-            echo "eee : ${fileout} already exists"
-            exit 1
-        fi
-        # write the previous line and the current line
-        echo "${memoline}" > ${fileout}
-        echo "${line}" >> ${fileout}
-    fi
-    # if current line contains "/" there will be no more lines to put in fileout
-    echo ${line} | grep -q "^/$"
-    if [ ${?} -eq 0 ]
-    then
-        echo "iii : detection of the end of ${block}"
-        echo "${line}" >> ${fileout}
-        fileout="/dev/null"
-    fi
-    # if current line is between "&" and "/", it should be written in fileout
-    # if current line is before the first &, it won't be written
-    if [ "${fileout}" != "/dev/null" ]
-    then
-        if [ ${begin} -eq 0 ]
-        then
-            echo "${line}" >> ${fileout}
-        fi
-    fi
-    # keep memory of this current line to use it if the next one is the
-    # beginning of a block
-    memoline=${line}
-    begin=0
-    # next line
-    il=$(( ${il} + 1 ))
-done
-#
-echo "iii : ${filein} is split in ${dirout}"
-#
-# end
-exit 0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm	(revision 10251)
@@ -13,6 +13,4 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 
@@ -31,4 +29,2 @@
 %USER_INC            %NCDF_INC
 %USER_LIB            %NCDF_LIB 
-%CC                  xlc
-%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm	(revision 10251)
@@ -13,6 +13,4 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 
@@ -31,4 +29,2 @@
 %USER_INC            %NCDF_INC
 %USER_LIB            %NCDF_LIB 
-%CC                  xlc
-%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm	(revision 10251)
@@ -13,6 +13,4 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 
@@ -31,4 +29,2 @@
 %USER_INC            %NCDF_INC
 %USER_LIB            %NCDF_LIB 
-%CC                  xlc
-%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 10251)
@@ -25,6 +25,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -58,5 +56,2 @@
 %USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB  -lnetcdff -lnetcdf -lstdc++ -lz -lcurl -lgpfs
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 10251)
@@ -13,6 +13,4 @@
 # USER_INC additional include files for the compiler, e.g. -I<include dir>
 # USER_LIB additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 
@@ -31,5 +29,3 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
-%CC                  icc
-%CFLAGS              -O0
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 10251)
@@ -13,6 +13,4 @@
 # USER_INC additional include files for the compiler, e.g. -I<include dir>
 # USER_LIB additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 
@@ -31,5 +29,3 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
-%CC                  icc
-%CFLAGS              -O0
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 10251)
@@ -13,6 +13,4 @@
 # USER_INC additional include files for the compiler, e.g. -I<include dir>
 # USER_LIB additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 
@@ -31,5 +29,3 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
-%CC                  icc
-%CFLAGS              -O0
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 10251)
@@ -25,6 +25,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -34,24 +32,22 @@
 
 # required modules
-# module load  INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel_shared NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel_shared
+# module load  INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel
 
 # Environment variables set by user. Others should automatically define when loading modules.
-#export XIOS=/users/home/models/nemo/xios
-#export HDF5=/users/home/opt/hdf5/hdf5-1.8.11_parallel_shared
-#export NETCDF=/users/home/opt/netcdf/netcdf-4.3_parallel_shared
+# export XIOS=/users/home/models/nemo/xios
 
-%NCDF_INC            -I${NETCDF}/include 
-%NCDF_LIB            -L${NETCDF}/lib -lnetcdff -lnetcdf
-%HDF5_INC            -I${HDF5}/include
-%HDF5_LIB            -L${HDF5}/lib -lhdf5_hl -lhdf5
-%XIOS_INC            -I${XIOS}/inc
-%XIOS_LIB            -L${XIOS}/lib -lxios
+%NCDF_INC            -I$NETCDF/include -I$PNETCDF/include
+%NCDF_LIB            -L$NETCDF/lib -lnetcdff -lnetcdf -L$PNETCDF/lib -lpnetcdf
+%HDF5_INC            -I$PHDF5/include
+%HDF5_LIB            -L$PHDF5/lib -lhdf5_hl -lhdf5
+%XIOS_INC            -I$XIOS/inc
+%XIOS_LIB            -L$XIOS/lib -lxios
 %CPP                 cpp
 %FC                  mpiifort
-%FCFLAGS             -r8 -O3 -xHost -fp-model source -traceback ${CFLAGS} 
+%FCFLAGS             -r8 -O3 -xHost -fp-model source -traceback
 %FFLAGS              %FCFLAGS
 %LD                  mpiifort
 %FPPFLAGS            -P -C -traditional
-%LDFLAGS             -lstdc++ -lz -lgpfs -lcurl  ${LDFLAGS}
+%LDFLAGS             -lstdc++ -lz -lgpfs -lcurl
 %AR                  ar 
 %ARFLAGS             -r
@@ -59,4 +55,2 @@
 %USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB
-%CC                  icc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 10251)
@@ -15,6 +15,4 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir>
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 %NCDF_INC            -I/srv/lib/netcdf-x/include
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -60,5 +58,2 @@
 #FCFLAGS             -g -traceback -r8 -O0 -xT -ip -vec-report0
 #FFLAGS              -g -traceback -r8 -O0 -xT -ip -vec-report0
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 10251)
@@ -17,6 +17,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -50,5 +48,2 @@
 %USER_INC            %XIOS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB %XLF90_LIB
-
-%CC                  xlc
-%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_METO.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 10251)
@@ -15,6 +15,4 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir>
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 
@@ -26,5 +24,5 @@
 %FC                  mpxlf90_r
 %FCFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
-%FFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
+%FFLAGS              -qrealsize=8 -qextname -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF -qfixed
 %LD                  mpCC_r
 %LDFLAGS             -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS
@@ -35,4 +33,2 @@
 %USER_INC            %NCDF_INC %XIOS_INC
 %USER_LIB            %NCDF_LIB %XIOS_LIB
-%CC                  xlc
-%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 10251)
@@ -15,6 +15,4 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir>
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 
 %NCDF_INC            -I/home/dcalve/netcdf/4.1.3_seq/include
@@ -34,5 +32,2 @@
 %USER_INC            %NCDF_INC %XIOS_INC
 %USER_LIB            %NCDF_LIB %XIOS_LIB
-
-%CC                  xlc
-%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_ADA.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -56,5 +54,2 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  icc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -55,5 +53,2 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  icc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_CURIE.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -60,5 +58,2 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 10251)
@@ -29,6 +29,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -60,5 +58,2 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_VAYU.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -55,5 +53,2 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -55,5 +53,2 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC40_METO.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -33,5 +31,5 @@
 %NCDF_HOME           /opt/cray/netcdf-hdf5parallel/4.3.2/CRAY/83
 %HDF5_HOME           /opt/cray/hdf5-parallel/1.8.13/CRAY/83
-%XIOS_HOME           /projects/ocean/nemo/xios/xios_1.0_r629_20150625/XIOS
+%XIOS_HOME           /projects/ocean/nemo/xios/xios_1.0_r618_20150619/XIOS
 
 %NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
@@ -53,5 +51,2 @@
 %USER_INC            %XIOS_INC
 %USER_LIB            %XIOS_LIB
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC_ARCHER.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -59,5 +57,2 @@
 #USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 #USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 10251)
@@ -24,6 +24,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -57,5 +55,2 @@
 #USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 #USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-macport_osx.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 10251)
@@ -33,6 +33,4 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -64,5 +62,2 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 10251)
@@ -13,6 +13,4 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir>
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
-# CC          C compiler used to compile conv for AGRIF
-# CFLAGS      compiler flags used with CC
 # debug: -g  -check bounds -check uninit -check pointers -traceback
 
@@ -33,5 +31,2 @@
 %USER_INC            -I$XIOS_INC %NCDF_INC
 %USER_LIB            -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++
-
-%CC                  cc
-%CFLAGS              -O0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 10251)
@@ -141,7 +141,4 @@
 &namtra_qsr    !   penetrative solar radiation
 !-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
-!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_chl      ='chlorophyll_PAPASTATION', -1    , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''       , ''
 /
 !-----------------------------------------------------------------------
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/file_def.xml
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/file_def.xml	(revision 10250)
+++ 	(revision )
@@ -1,65 +1,0 @@
-    <!-- 
-============================================================================================================
-=                                           output files definition                                        =
-=                                            Define your own files                                         =
-=                                         put the variables you want...                                    =
-============================================================================================================
-    -->
-    
-    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
-    
-      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
-      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
-      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
-      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
-      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
-      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
-     
-      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
-      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
-      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->  
- 
-	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="toce"         name="votemper"  />
-	  <field field_ref="soce"         name="vosaline"  />
-	  <field field_ref="sst"          name="sosstsst"  />
-	  <field field_ref="sss"          name="sosaline"  />
-	  <field field_ref="ssh"          name="sossheig"  />
-	  <field field_ref="empmr"        name="sowaflup"  />
-	  <field field_ref="qsr"          name="soshfldo"  />
-      <field field_ref="saltflx"      name="sosfldow"  />
-	  <field field_ref="qt"           name="sohefldo"  />
-	  <field field_ref="mldr10_1"     name="somxl010"  />
-	  <field field_ref="mldkz5"       name="somixhgt"  />
-    </file>
-	
-	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
-          <field field_ref="uoce"         name="vozocrtx"  />
-          <field field_ref="utau"         name="sozotaux"  />
-    </file>
-	
-	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
-          <field field_ref="voce"         name="vomecrty"  /> 
-          <field field_ref="vtau"         name="sometauy"  /> 
-    </file>
-	
-	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
-          <field field_ref="woce"         name="vovecrtz" />
-          <field field_ref="avt"          name="votkeavt" />
-          <field field_ref="aht2d"        name="soleahtw" />
-    </file>
-
-      </file_group>
-      
-      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
-      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
-      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
-      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
-      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
-
-      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
-      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
-      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
-      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
-
-   </file_definition>
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml	(revision 10251)
@@ -2,5 +2,5 @@
 <simulation> 
 
- <context id="nemo" >
+ <context id="nemo" time_origin="1900-01-01 00:00:00" >
     
     <!-- $id$ -->
@@ -19,10 +19,65 @@
 =                                         put the variables you want...                                    =
 ============================================================================================================
-       -->
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->  
+ 
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="votemper"  />
+	  <field field_ref="soce"         name="vosaline"  />
+	  <field field_ref="sst"          name="sosstsst"  />
+	  <field field_ref="sss"          name="sosaline"  />
+	  <field field_ref="ssh"          name="sossheig"  />
+	  <field field_ref="empmr"        name="sowaflup"  />
+	  <field field_ref="qsr"          name="soshfldo"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
+	  <field field_ref="qt"           name="sohefldo"  />
+	  <field field_ref="mldr10_1"     name="somxl010"  />
+	  <field field_ref="mldkz5"       name="somixhgt"  />
+    </file>
+	
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="uoce"         name="vozocrtx"  />
+          <field field_ref="utau"         name="sozotaux"  />
+    </file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="voce"         name="vomecrty"  /> 
+          <field field_ref="vtau"         name="sometauy"  /> 
+    </file>
+	
+	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
+          <field field_ref="woce"         name="vovecrtz" />
+          <field field_ref="avt"          name="votkeavt" />
+          <field field_ref="aht2d"        name="soleahtw" />
+    </file>
 
-    <file_definition src="./file_def.xml"/>
+      </file_group>
+      
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
 
-    <!--
- 
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
+    <!-- 
 ============================================================================================================
 = grid definition = = DO NOT CHANGE =
@@ -45,34 +100,12 @@
    
    <grid_definition>    
-     <grid id="grid_T_2D" >
-       <domain id="grid_T" />
-     </grid>
-     <grid id="grid_T_3D" >
-       <domain id="grid_T" />
-       <axis id="deptht" />
-     </grid>
-     <grid id="grid_U_2D" >
-       <domain id="grid_U" />
-     </grid>
-     <grid id="grid_U_3D" >
-       <domain id="grid_U" />
-       <axis id="depthu" />
-     </grid>
-     <grid id="grid_V_2D" >
-       <domain id="grid_V" />
-     </grid>
-     <grid id="grid_V_3D" >
-       <domain id="grid_V" />
-       <axis id="depthv" />
-     </grid>
-     <grid id="grid_W_2D" >
-       <domain id="grid_W" />
-     </grid>
-     <grid id="grid_W_3D" >
-       <domain id="grid_W" />
-       <axis id="depthw" />
-     </grid>
-     <grid id="scalarpoint" />
-
+     <grid id="grid_T_2D" domain_ref="grid_T"/>
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+     <grid id="grid_U_2D" domain_ref="grid_U"/>
+     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
+     <grid id="grid_V_2D" domain_ref="grid_V"/>
+     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
+     <grid id="grid_W_2D" domain_ref="grid_W"/>
+     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
     </grid_definition> 
 
@@ -87,7 +120,9 @@
         We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
 -->
-	  <variable id="info_level"                type="int">0</variable>
-	  <variable id="using_server"              type="bool">false</variable>
-	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="buffer_size"               type="integer">10000000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">0</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
 	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
 	
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm	(revision 10251)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_xios2
+ bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg	(revision 10251)
@@ -6,5 +6,5 @@
 !-----------------------------------------------------------------------
    cn_exp      = "Agulhas" !  experience name 
-   nn_itend    =   10950   !  last  time step
+   nn_itend    =     480   !  last  time step
    nn_stock    =   10950   !  frequency of creation of a restart file (modulo referenced to 1)
    nn_write    =   10950   !  frequency of write in the output file   (modulo referenced to nn_it000)
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 10251)
@@ -153,148 +153,4 @@
   </context>
   
- <context id="1_nemo" time_origin="1950-01-01 00:00:00" >
-    
-    <!-- $id$ -->
-    
-    <!-- 
-============================================================================================================
-=                                  definition of all existing variables                                    =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    <field_definition src="./field_def.xml"/>
-    <!-- 
-============================================================================================================
-=                                           output files definition                                        =
-=                                            Define your own files                                         =
-=                                         put the variables you want...                                    =
-============================================================================================================
-    -->
-    
-    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
-    
-      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
-      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
-      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
-      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
-      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
-      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
-      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
-      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
-
-      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE." >  <!-- 5d files -->  
- 
-	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
-	  <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               />
-	  <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            />
-	  <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
-	  <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"      />
-	  <field field_ref="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
-	  <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     />
-	  <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           />
-	  <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          />
-	  <field field_ref="saltflx"      name="sosflxdo"  />
-	  <field field_ref="taum"         name="taum" />
-	  <field field_ref="wspd"         name="sowindsp"  />
-          <field field_ref="precip"       name="soprecip" />
-	</file>
-
-	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
-          <!-- variables available with MLE
-          <field field_ref="psiu_mle"     name="psiu_mle"  long_name="MLE_streamfunction_along_i-axis" />
-	  -->
-	</file>
-	
-	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
-          <!-- variables available with MLE
-          <field field_ref="psiv_mle"     name="psiv_mle"  long_name="MLE_streamfunction_along_j-axis" />
-	  -->
-	</file>
-	
-	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
-	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
-	</file>
-<!--
-	<file id="file6" name_suffix="_icemod" description="ice variables" >
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   />
-	  <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        />
-	  <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        />
-	  <field field_ref="ist_ipa"      />
-	  <field field_ref="uice_ipa"     />
-	  <field field_ref="vice_ipa"     />
-	  <field field_ref="utau_ice"     />
-	  <field field_ref="vtau_ice"     />
-	  <field field_ref="qsr_io_cea"   />
-	  <field field_ref="qns_io_cea"   />
-	  <field field_ref="snowpre"      />
-	</file>
-
-	<file id="file8" name_suffix="_Tides" description="tidal harmonics" >
-	  <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       />
-	  <field field_ref="M2y"          name="M2y"      long_name="M2 Elevation harmonic imaginary part"                  />
-	  <field field_ref="M2x_u"        name="M2x_u"    long_name="M2 current barotrope along i-axis harmonic real part "       />
-	  <field field_ref="M2y_u"        name="M2y_u"    long_name="M2 current barotrope along i-axis harmonic imaginary part "  />
-	  <field field_ref="M2x_v"        name="M2x_v"    long_name="M2 current barotrope along j-axis harmonic real part "       />
-	  <field field_ref="M2y_v"        name="M2y_v"    long_name="M2 current barotrope along j-axis harmonic imaginary part "  />
-	</file>
-	-->
-      </file_group>
-
-
-      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
-
-
-      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
-      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
-      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
-      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
-
-      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
-      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
-      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
-      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
-
-   </file_definition>
-    
-    <!-- 
-============================================================================================================
-= grid definition = = DO NOT CHANGE =
-============================================================================================================
-    -->
-    
-   <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-   </axis_definition> 
-    
-   <domain_definition src="./domain_def.xml"/>
-   
-   <grid_definition>    
-     <grid id="grid_T_2D" domain_ref="grid_T"/>
-     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
-     <grid id="grid_U_2D" domain_ref="grid_U"/>
-     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
-     <grid id="grid_V_2D" domain_ref="grid_V"/>
-     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
-     <grid id="grid_W_2D" domain_ref="grid_W"/>
-     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
-    </grid_definition>   
-  </context>
 
   <context id="xios">
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/makenemo
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/makenemo	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/CONFIG/makenemo	(revision 10251)
@@ -360,24 +360,4 @@
     cd ${NEMO_TDIR}/${NEW_CONF} || cd -
 
-    #-
-    #- Get git version information if available
-    mkdir -p ${CONFIG_DIR}/${NEW_CONF}/BLD/inc
-    GITVERSIONHEADER=${CONFIG_DIR}/${NEW_CONF}/BLD/inc/gitversion.h90
-    echo "Extracting git commit info into" $GITVERSIONHEADER
-    NEMOCOMMIT=$( git describe --always --dirty )
-    if [ $? -ne 0 ]
-    then
-       echo "Unable to extract git commit info!"
-       NEMOCOMMIT="NOT AVAILABLE"
-    fi
-    echo "#define _NEMO_COMMIT_ID_ '${NEMOCOMMIT}'" > ${GITVERSIONHEADER}
-    NEMOBRANCH=$( git name-rev --name-only HEAD )
-    if [ $? -ne 0 ]
-    then
-       echo "Unable to extract git branch info!"
-       NEMOBRANCH="UNKNOWN"
-    fi
-    echo "#define _NEMO_BRANCH_ '${NEMOBRANCH}'" >> ${GITVERSIONHEADER}
-
 #if AGRIF we do a first preprocessing
     if [ ${#x_c} -eq 0 ]; then
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 10251)
@@ -0,0 +1,1175 @@
+!
+! $Id: modarrays.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Arrays
+C      
+      Module Agrif_Arrays
+      Use Agrif_Types
+C
+      implicit none
+C      
+      Contains
+C     **************************************************************************
+CCC   Subroutine Agrif_Childbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Childbounds(nbdim,lboundloc,uboundloc,
+     &                 pttab,petab,pttruetab,cetruetab,memberin)
+C
+CCC   Description:
+CCC   Subroutine calculating the global indices of the child grid
+C
+C
+C     Declarations:
+C
+
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lboundloc,uboundloc
+      INTEGER,DIMENSION(nbdim) :: pttab,petab,pttruetab,cetruetab
+      LOGICAL :: memberin
+C
+C     Local variables
+      INTEGER :: i,lbglob,ubglob
+C
+#ifdef key_mpp_mpi
+      INTEGER :: indglob1,indglob2
+#endif
+C
+C
+      do i = 1,nbdim
+C
+        lbglob = lboundloc(i)
+        ubglob = uboundloc(i)
+C
+#ifdef key_mpp_mpi
+C
+        Call AGRIF_InvLoc(lbglob,Agrif_ProcRank,i,indglob1)
+C
+        Call AGRIF_InvLoc(ubglob,Agrif_ProcRank,i,indglob2)
+C
+        pttruetab(i) = max(pttab(i),indglob1)        
+C
+        cetruetab(i) = min(petab(i),indglob2)                 
+C
+#else
+C
+        pttruetab(i) = max(pttab(i),lbglob)        
+C
+        cetruetab(i) = min(petab(i),ubglob)
+C
+#endif
+C
+      enddo
+
+      memberin = .TRUE.
+
+      do i=1,nbdim
+        IF (cetruetab(i) < pttruetab(i)) THEN
+          memberin = .FALSE.
+          EXIT
+        ENDIF
+      enddo
+C
+      Return
+C
+C
+      End Subroutine Agrif_Childbounds
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Get_bound
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Get_bound(Variable,
+     &                           lower,upper,indice,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C     table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      ! we want extract boundaries of this table
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      INTEGER              :: lower,upper ! output data
+      ! direction in wich we want to know the dimension
+      INTEGER              :: indice      
+      INTEGER              :: nbdim       ! dimension of the table
+C
+C     Local variables
+C
+
+      lower = Variable % lb(indice)
+      upper = Variable % ub(indice)
+      return
+C
+      End Subroutine Agrif_nbdim_Get_bound       
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Get_bound_dimension
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Get_bound_dimension(Variable,
+     &                              lower,upper,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C        table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      ! we want extract boundaries of this table
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: lower,upper ! output data
+C
+C     Local variables       
+C
+      lower = Variable % lb(1:nbdim)
+      upper = Variable % ub(1:nbdim)
+      return
+C
+      End Subroutine Agrif_nbdim_Get_bound_dimension     
+      
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_allocation
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_allocation(Variable,inf,sup,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to Allocate the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         allocate(Variable%array1(
+     &            inf(1):sup(1)))
+      CASE (2)
+          allocate(Variable%array2(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2)))
+      CASE (3)
+         allocate(Variable%array3(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3)))
+      CASE (4)
+         allocate(Variable%array4(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4)))
+      CASE (5)
+         allocate(Variable%array5(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4),
+     &            inf(5):sup(5)))
+      CASE (6)
+         allocate(Variable%array6(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4),
+     &            inf(5):sup(5),
+     &            inf(6):sup(6)))
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_allocation
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_deallocation
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_deallocation(Variable,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the same value to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+
+      SELECT CASE (nbdim)
+      CASE (1)
+         Deallocate(Variable%array1)
+      CASE (2)
+         Deallocate(Variable%array2)
+      CASE (3)
+         Deallocate(Variable%array3)
+      CASE (4)
+         Deallocate(Variable%array4)
+      CASE (5)
+         Deallocate(Variable%array5)
+      CASE (6)
+         Deallocate(Variable%array6)
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_deallocation
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Full_VarEQreal
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Full_VarEQreal(Variable,Value,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C        table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      REAL                 :: Value       
+      INTEGER              :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+        Variable%array1 = Value      
+      CASE (2)
+        Variable%array2 = Value
+      CASE (3)
+        Call Agrif_set_tozero3D(Variable%array3)
+!        Variable%array3 = Value
+      CASE (4)
+        Variable%array4 = Value
+      CASE (5)
+        Variable%array5 = Value
+      CASE (6)
+        Variable%array6 = Value
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_Full_VarEQreal   
+      
+      Subroutine Agrif_set_tozero3D(tab3D)
+      real,dimension(:,:,:),target :: tab3D
+      
+      tab3D = 0.
+      
+      end subroutine agrif_set_tozero3D    
+C
+C
+#if !defined key_mpp_mpi
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_VarEQreal
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_VarEQreal(Variable,inf,sup,Value,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the same value to a part of 
+C        the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      REAL                 :: Value       
+      INTEGER              :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         Variable%array1(
+     &             inf(1):sup(1)
+     &             )  = Value
+      CASE (2)
+         Variable%array2(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2)
+     &             )  = Value
+      CASE (3)
+         Variable%array3(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3)
+     &             )  = Value
+      CASE (4)
+         Variable%array4(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4)
+     &             )  = Value
+      CASE (5)
+         Variable%array5(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4),
+     &             inf(5):sup(5)
+     &             )  = Value
+      CASE (6)
+         Variable%array6(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4),
+     &             inf(5):sup(5),
+     &             inf(6):sup(6)
+     &             )  = Value
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_VarEQreal       
+#endif
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_VarEQvar
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_VarEQvar(Variable,inf,sup,
+     &                                Variable2,inf2,sup2,
+     &                                nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the value of a part of the table 
+C        Variable2 to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable
+      TYPE(AGRIF_Variable), Pointer     :: Variable2
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+      INTEGER,DIMENSION(nbdim) :: inf2,sup2
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         Variable%array1(inf(1):sup(1)) = 
+     &         Variable2%array1(inf2(1):sup2(1))
+      CASE (2)
+     
+      Call Agrif_Copy_2d(Variable%array2,Variable2%array2,
+     &  lbound(Variable%array2),
+     &  lbound(Variable2%array2),
+     &  inf,sup,inf2,sup2)
+          
+      CASE (3)
+
+      Call Agrif_Copy_3d(Variable%array3,Variable2%array3,
+     &  lbound(Variable%array3),
+     &  lbound(Variable2%array3),
+     &  inf,sup,inf2,sup2)
+
+      CASE (4)
+      
+      Call Agrif_Copy_4d(Variable%array4,Variable2%array4,
+     &  lbound(Variable%array4),
+     &  lbound(Variable2%array4),
+     &  inf,sup,inf2,sup2)
+     
+      CASE (5)
+        Variable%array5(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3),
+     &                         inf(4):sup(4), 
+     &                         inf(5):sup(5)) = 
+     &         Variable2%array5(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4),
+     &                          inf2(5):sup2(5))
+      CASE (6)
+        Variable%array6(inf(1):sup(1),
+     &                         inf(2):sup(2),
+     &                         inf(3):sup(3),
+     &                         inf(4):sup(4),
+     &                         inf(5):sup(5),
+     &                         inf(6):sup(6)) = 
+     &         Variable2%array6(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4),
+     &                          inf2(5):sup2(5),
+     &                          inf2(6):sup2(6))
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_VarEQvar
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Full_VarEQvar
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Full_VarEQvar(Variable,Variable2,
+     &                                nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the value of the table Variable2 
+C        to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable
+      TYPE(AGRIF_Variable), Pointer     :: Variable2
+      INTEGER                  :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+          Variable%array1 = Variable2%array1
+      CASE (2)
+          Variable%array2 = Variable2%array2
+      CASE (3)
+          Variable%array3 = Variable2%array3
+      CASE (4)
+          Variable%array4 = Variable2%array4
+      CASE (5)
+          Variable%array5 = Variable2%array5
+      CASE (6)
+          Variable%array6 = Variable2%array6
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_Full_VarEQvar
+C
+C
+
+C     **************************************************************************
+CCC   Subroutine GiveAgrif_SpecialValueToTab_mpi
+C     **************************************************************************
+C
+      Subroutine GiveAgrif_SpecialValueToTab_mpi(Variable1,Variable2,
+     &                  bound1,lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(:,:,:) :: bound1
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+             Where (Variable1 % array1(
+     &           bound1(1,1,2):bound1(1,2,2)) 
+     &            == Value)
+             Variable2 % array1(bound1(1,1,1):bound1(1,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (2)
+             Where (Variable1 % array2(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &           bound1(2,1,2):bound1(2,2,2)) 
+     &            == Value)
+             Variable2 % array2(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (3)
+             Where (Variable1 % array3(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2)) 
+     &            == Value)
+             Variable2 % array3(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1))
+     &                         = Value
+C      
+              End Where
+      CASE (4)
+             Where (Variable1 % array4(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2)) 
+     &            == Value)
+             Variable2 % array4(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (5)
+             Where (Variable1 % array5(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2),
+     &                       bound1(5,1,2):bound1(5,2,2)) 
+     &            == Value)
+             Variable2 % array5(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1),
+     &                       bound1(5,1,1):bound1(5,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (6)
+             Where (Variable1 % array6(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2),
+     &                       bound1(5,1,2):bound1(5,2,2),
+     &                       bound1(6,1,2):bound1(6,2,2)) 
+     &            == Value)
+             Variable2 % array6(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1),
+     &                       bound1(5,1,1):bound1(5,2,1),
+     &                       bound1(6,1,1):bound1(6,2,1))
+     &                        = Value
+C      
+              End Where
+      END SELECT
+C
+      return
+C
+      End Subroutine GiveAgrif_SpecialValueToTab_mpi    
+
+C     **************************************************************************
+CCC   Subroutine GiveAgrif_SpecialValueToTab
+C     **************************************************************************
+C
+      Subroutine GiveAgrif_SpecialValueToTab(Variable1,Variable2,
+     &                  lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+             Where (Variable1 % array1(
+     &           lower(1):upper(1))
+     &            == Value)
+             Variable2 % array1(lower(1):upper(1))
+     &                        = Value
+C      
+              End Where
+      CASE (2)
+             Where (Variable1 % array2(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2)) 
+     &            == Value)
+             Variable2 % array2(lower(1):upper(1),
+     &                          lower(2):upper(2))
+     &                        = Value
+C      
+              End Where
+      CASE (3)
+             Where (Variable1 % array3(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2), 
+     &           lower(3):upper(3)) 
+     &            == Value)
+             Variable2 % array3(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3))
+     &                         = Value
+C      
+              End Where
+      CASE (4)
+             Where (Variable1 % array4(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2), 
+     &           lower(3):upper(3),
+     &           lower(4):upper(4)) 
+     &            == Value)
+             Variable2 % array4(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4))
+     &                        = Value
+C      
+              End Where
+      CASE (5)
+             Where (Variable1 % array5(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2),
+     &           lower(3):upper(3),
+     &           lower(4):upper(4),
+     &           lower(5):upper(5)) 
+     &            == Value)
+             Variable2 % array5(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4),
+     &                          lower(5):upper(5))
+     &                        = Value
+C      
+              End Where
+      CASE (6)
+             Where (Variable1 % array6(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2),
+     &           lower(2):upper(3),
+     &           lower(4):upper(4),
+     &           lower(5):upper(5),
+     &           lower(6):upper(6)) 
+     &            == Value)
+             Variable2 % array6(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4),
+     &                          lower(5):upper(5),
+     &                          lower(6):upper(6))
+     &                        = Value
+C      
+              End Where
+      END SELECT
+C
+      return
+C
+      End Subroutine GiveAgrif_SpecialValueToTab   
+
+C
+C
+#ifdef key_mpp_mpi
+C     **************************************************************************
+CCC   Subroutine Where_ValTabToTab_mpi
+C     **************************************************************************
+C
+      Subroutine Where_ValTabToTab_mpi(
+     &                  Variable1,Variable2,
+     &                  lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer     :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer     :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+      INTEGER :: i,j,k,l,m,n
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+            DO i = lower(1),upper(1)
+              IF (variable1%array1(i) == Value) then
+                variable1%array1(i)=Variable2%array1(i)
+              ENDIF
+            ENDDO
+      CASE (2)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array2(i,j) == Value) then
+                variable1%array2(i,j)=Variable2%array2(i,j)
+              ENDIF
+            ENDDO
+            ENDDO
+      CASE (3)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array3(i,j,k) == Value) then
+                variable1%array3(i,j,k)=Variable2%array3(i,j,k)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (4)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array4(i,j,k,l) == Value) then
+                variable1%array4(i,j,k,l)=Variable2%array4(i,j,k,l)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (5)
+            DO m = lower(5),upper(5)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array5(i,j,k,l,m) == Value) then
+              variable1%array5(i,j,k,l,m)=Variable2%array5(i,j,k,l,m)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (6)
+            DO n = lower(6),upper(6)
+            DO m = lower(5),upper(5)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array6(i,j,k,l,m,n) == Value) then
+            variable1%array6(i,j,k,l,m,n)=Variable2%array6(i,j,k,l,m,n)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      END SELECT
+C
+      return
+C
+      End Subroutine Where_ValTabToTab_mpi    
+#endif
+
+C     **************************************************************************
+CCC   Subroutine PreProcessToInterpOrUpdate
+C     **************************************************************************
+C
+      Subroutine PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child,
+     &             pttab_Child,pttab_Parent,
+     &             s_Child,s_Parent,
+     &             ds_Child,ds_Parent,
+     &             nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+C     arguments                                   
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
+      INTEGER :: nbdim                  
+      INTEGER,DIMENSION(6) :: pttab_child  
+      INTEGER,DIMENSION(6) :: petab_child      
+      INTEGER,DIMENSION(6) :: pttab_parent  
+      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
+                                            ! root grid
+      TYPE(Agrif_Grid), Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
+      REAL, DIMENSION(6) :: s_child,s_parent
+      REAL, DIMENSION(6) :: ds_child,ds_parent
+C     locals variables
+      INTEGER :: n
+      
+C
+C     Arguments      
+C
+
+C
+C     Local variables       
+C
+      Agrif_Child_Gr => Agrif_Curgrid
+      Agrif_Parent_Gr => Agrif_Curgrid % parent
+C
+      root => child % var % root_var 
+C
+C     Number of dimensions of the current grid
+      nbdim = root % nbdim
+C      
+      do n=1,nbdim
+C            
+        Select case(root % interptab(n))
+C
+C       Value of interptab(n) can be either x,y,z or N for a no space 
+C       DIMENSION            
+C
+C         The DIMENSION is 'x'
+          case('x')
+C
+            pttab_Child(n) = root % point(1)
+C            
+            pttab_Parent(n) = root % point(1)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+              petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(1)
+C        
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                              Agrif_Child_Gr%nb(1) - 1
+C          
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif                  
+C
+C         The DIMENSION is 'y'
+          case('y')
+C
+            pttab_Child(n) = root % point(2)
+C            
+            pttab_Parent(n) = root % point(2)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(2)
+C          
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                       Agrif_Child_Gr%nb(2) - 1
+C          
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif
+            
+C
+C         The DIMENSION is 'z'                            
+          case('z')
+C
+            pttab_Child(n) = root % point(3)
+C            
+            pttab_Parent(n) = root % point(3)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(3)
+C          
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                      Agrif_Child_Gr%nb(3) - 1
+C
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif       
+C 
+C         The DIMENSION is not space                            
+          case('N')
+C
+C         The next coefficients are calculated in order to do a simple copy of 
+C         values of the grid variable when the procedure of interpolation is 
+C         called for this DIMENSION 
+C      
+            Call Agrif_nbdim_Get_bound(child % var,
+     &                           pttab_Child(n),petab_Child(n),n,nbdim)
+C
+C           No interpolation but only a copy of the values of the grid variable
+C
+            pttab_Parent(n) = pttab_Child(n)
+C              
+            s_Child(n)=0.
+C      
+            s_Parent(n)=0. 
+C      
+            ds_Child(n)=1.
+C      
+            ds_Parent(n)=1.
+C
+        End select
+C            
+      enddo     
+C
+      return
+C
+      End Subroutine PreProcessToInterpOrUpdate     
+
+#ifdef key_mpp_mpi
+C
+C     **************************************************************************
+CCC   Subroutine GetLocalBoundaries
+C     **************************************************************************
+C
+      Subroutine GetLocalBoundaries(tab1,tab2,i,lb,ub,deb,fin)
+C
+CCC   Descritpion:
+C 
+C
+C     Declarations:
+C
+
+C
+C
+C     Scalar arguments
+      INTEGER  ::  tab1,tab2
+      INTEGER  ::  i
+      INTEGER  ::  lb,ub
+      INTEGER  ::  deb,fin
+C
+C     Local scalars
+      INTEGER  ::  imin,imax
+      INTEGER  ::  i1,i2
+C
+C
+      Call AGRIF_InvLoc(lb,AGRIF_ProcRank,i,imin)
+C
+      Call AGRIF_InvLoc(ub,AGRIF_ProcRank,i,imax)
+C
+C
+      if (imin > tab2) then
+C
+          i1 = imax - imin
+C
+        else
+C
+          i1 = max(tab1 - imin,0)
+C
+      endif
+C
+      if (imax < tab1) then
+C
+          i2 = -(imax - imin)
+C
+        else
+C
+          i2 = min(tab2 - imax,0)
+C
+      endif
+C
+      deb = lb + i1
+C
+      fin = ub + i2
+C
+C
+      End Subroutine GetLocalBoundaries
+C
+#endif
+C
+C
+#ifdef key_mpp_mpi
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_GlobtoLocInd2
+C     **************************************************************************
+C
+      Subroutine Agrif_GlobtoLocInd2(tabarray,lboundl,uboundl,tab1,tab2,
+     &                              nbdim,rank,member)
+C
+CCC   Description:
+CCC   For a global index located on the current processor, tabarray gives the 
+CCC   corresponding local index   
+C
+C
+C     Declarations:
+C
+
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: tab1,tab2
+      INTEGER,DIMENSION(nbdim,2,2 ) :: tabarray
+      INTEGER,DIMENSION(nbdim) :: lboundl,uboundl
+      INTEGER :: rank
+      LOGICAL :: member
+C    
+C     Local variables
+      INTEGER :: i,i1,k
+      INTEGER :: nbloc(nbdim)
+C
+C
+      tabarray(:,1,:) =  HUGE(1)
+      tabarray(:,2,:) =  -HUGE(1)
+
+      nbloc = 0
+C        
+      do i = 1,nbdim
+C       
+        Call Agrif_Invloc(lboundl(i),rank,i,i1)
+        
+        do k=tab1(i)+lboundl(i)-i1,tab2(i)+lboundl(i)-i1
+          IF ((k .GE. lboundl(i)) .AND. (k.LE.uboundl(i))) THEN
+            nbloc(i) = 1
+            tabarray(i,1,1) = min(tabarray(i,1,1),k-lboundl(i)+i1)
+            tabarray(i,2,1) = max(tabarray(i,2,1),k-lboundl(i)+i1)
+        
+            tabarray(i,1,2) = min(tabarray(i,1,2),k)
+            tabarray(i,2,2) = max(tabarray(i,2,2),k)
+          ENDIF
+        enddo
+C
+      enddo
+
+      member = .FALSE.
+      IF (sum(nbloc) == nbdim) member = .TRUE.
+C
+      Return
+C
+C
+      End Subroutine Agrif_GlobtoLocInd2
+C
+#endif      
+
+      Subroutine Agrif_Copy_2d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(2) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):) :: tabout
+      real,target,dimension(m(1):,m(2):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2))
+      End Subroutine Agrif_Copy_2d
+      
+      Subroutine Agrif_Copy_3d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(3) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):,l(3):) :: tabout
+      real,target,dimension(m(1):,m(2):,m(3):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3))
+      End Subroutine Agrif_Copy_3d
+      
+      Subroutine Agrif_Copy_4d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(4) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):,l(3):,l(4):) :: tabout
+      real,target,dimension(m(1):,m(2):,m(3):,m(4):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3), 
+     &                         inf(4):sup(4)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4))
+      End Subroutine Agrif_Copy_4d      
+
+      End Module Agrif_Arrays
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 10250)
+++ 	(revision )
@@ -1,826 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_Arrays
-!
-module Agrif_Arrays
-!
-    use Agrif_Types
-    use Agrif_Grids
-!
-    implicit none
-!
-#if defined AGRIF_MPI
-    interface
-        subroutine Agrif_InvLoc ( indloc, proc_id, dir, indglob )
-            integer, intent(in)     :: indloc   !< local index
-            integer, intent(in)     :: proc_id  !< rank of the proc calling this function
-            integer, intent(in)     :: dir      !< direction of the index
-            integer, intent(out)    :: indglob  !< global index
-        end subroutine Agrif_InvLoc
-    end interface
-    private :: Agrif_InvLoc
-#endif
-!
-contains
-!
-!===================================================================================================
-! subroutine Agrif_Childbounds
-!
-!> Computes the global indices of the child grid
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Childbounds ( nbdim,           &
-                               lb_var, ub_var,  &
-                               lb_tab, ub_tab,  &
-                               proc_id,         &
-                               coords,          &
-                               lb_tab_true, ub_tab_true, memberin )
-!---------------------------------------------------------------------------------------------------
-    integer,                   intent(in)  :: nbdim         !< Number of dimensions
-    integer, dimension(nbdim), intent(in)  :: lb_var        !< Local lower boundary on the current processor
-    integer, dimension(nbdim), intent(in)  :: ub_var        !< Local upper boundary on the current processor
-    integer, dimension(nbdim), intent(in)  :: lb_tab        !< Global lower boundary of the variable
-    integer, dimension(nbdim), intent(in)  :: ub_tab        !< Global upper boundary of the variable
-    integer,                   intent(in)  :: proc_id       !< Current processor
-    integer, dimension(nbdim), intent(in)  :: coords
-    integer, dimension(nbdim), intent(out) :: lb_tab_true   !< Global value of lb_var on the current processor
-    integer, dimension(nbdim), intent(out) :: ub_tab_true   !< Global value of ub_var on the current processor
-    logical,                   intent(out) :: memberin
-!
-    integer :: i, coord_i
-    integer :: lb_glob_index, ub_glob_index ! Lower and upper global indices
-!
-    do i = 1, nbdim
-!
-        coord_i = coords(i)
-!
-#if defined AGRIF_MPI
-        call Agrif_InvLoc( lb_var(i), proc_id, coord_i, lb_glob_index )
-        call Agrif_InvLoc( ub_var(i), proc_id, coord_i, ub_glob_index )
-#else
-        lb_glob_index = lb_var(i)
-        ub_glob_index = ub_var(i)
-#endif
-        lb_tab_true(i) = max(lb_tab(i), lb_glob_index)
-        ub_tab_true(i) = min(ub_tab(i), ub_glob_index)
-    enddo
-!
-    memberin = .true.
-    do i = 1,nbdim
-        if (ub_tab_true(i) < lb_tab_true(i)) then
-            memberin = .false.
-            exit
-        endif
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Childbounds
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_get_var_global_bounds( var, lubglob, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),        intent(in)  :: var
-    integer, dimension(nbdim,2), intent(out) :: lubglob
-    integer,                     intent(in)  :: nbdim
-!
-#if defined AGRIF_MPI
-    include 'mpif.h'
-    integer, dimension(nbdim)   :: lb, ub
-    integer, dimension(nbdim,2) :: iminmaxg
-    integer :: i, code, coord_i
-#endif
-!
-#if !defined AGRIF_MPI
-    call Agrif_get_var_bounds_array(var, lubglob(:,1), lubglob(:,2), nbdim)
-#else
-    call Agrif_get_var_bounds_array(var, lb, ub, nbdim)
-
-    do i = 1,nbdim
-        coord_i = var % root_var % coords(i)
-        call Agrif_InvLoc( lb(i), Agrif_Procrank, coord_i, iminmaxg(i,1) )
-        call Agrif_InvLoc( ub(i), Agrif_Procrank, coord_i, iminmaxg(i,2) )
-    enddo
-!
-    iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
-    call MPI_ALLREDUCE(iminmaxg, lubglob, 2*nbdim, MPI_INTEGER, MPI_MIN, Agrif_mpi_comm, code)
-    lubglob(1:nbdim,2)  = - lubglob(1:nbdim,2)
-#endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_get_var_global_bounds
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_get_var_bounds
-!
-!> Gets the lower and the upper boundaries of a variable, for one particular direction.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_get_var_bounds ( variable, lower, upper, index )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), intent(in)    :: variable   !< Variable for which we want to extract boundaries
-    integer,              intent(out)   :: lower      !< Lower bound
-    integer,              intent(out)   :: upper      !< Upper bound
-    integer,              intent(in)    :: index      !< Direction for wich we want to know the boundaries
-!
-    lower = variable % lb(index)
-    upper = variable % ub(index)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_get_var_bounds
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_get_var_bounds_array
-!
-!> Gets the lower and the upper boundaries of a table.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_get_var_bounds_array ( variable, lower, upper, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),      intent(in)   :: variable   !< Variable for which we want to extract boundaries
-    integer, dimension(nbdim), intent(out)  :: lower      !< Lower bounds array
-    integer, dimension(nbdim), intent(out)  :: upper      !< Upper bounds array
-    integer, intent(in)                     :: nbdim      !< Numer of dimensions of the variable
-!
-    lower = variable % lb(1:nbdim)
-    upper = variable % ub(1:nbdim)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_get_var_bounds_array
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_array_allocate
-!
-!> Allocates data array in \b variable, according to the required dimension.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_array_allocate ( variable, lb, ub, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),      intent(inout) :: variable    !< Variable struct for allocation
-    integer, dimension(nbdim), intent(in)    :: lb          !< Lower bound
-    integer, dimension(nbdim), intent(in)    :: ub          !< Upper bound
-    integer,                   intent(in)    :: nbdim       !< Dimension of the array
-!
-    select case (nbdim)
-    case (1) ; allocate(variable%array1(lb(1):ub(1)))
-    case (2) ; allocate(variable%array2(lb(1):ub(1),lb(2):ub(2)))
-    case (3) ; allocate(variable%array3(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))
-    case (4) ; allocate(variable%array4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4)))
-    case (5) ; allocate(variable%array5(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5)))
-    case (6) ; allocate(variable%array6(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6)))
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_array_allocate
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_array_deallocate
-!
-!> Dellocates data array in \b variable, according to the required dimension.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_array_deallocate ( variable, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), intent(inout) :: variable     !< Variable struct for deallocation
-    integer,              intent(in)    :: nbdim        !< Dimension of the array
-!
-    select case (nbdim)
-    case (1) ; deallocate(variable%array1)
-    case (2) ; deallocate(variable%array2)
-    case (3) ; deallocate(variable%array3)
-    case (4) ; deallocate(variable%array4)
-    case (5) ; deallocate(variable%array5)
-    case (6) ; deallocate(variable%array6)
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_array_deallocate
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_var_set_array_tozero
-!
-!> Reset the value of the data array in \b variable, according to the required dimension.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_var_set_array_tozero ( variable, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), intent(inout) :: variable     !< Variable
-    integer, intent(in)                 :: nbdim        !< Dimension of the array you want to reset
-!
-    select case (nbdim)
-    case (1) ; call Agrif_set_array_tozero_1D(variable%array1)
-    case (2) ; call Agrif_set_array_tozero_2D(variable%array2)
-    case (3) ; call Agrif_set_array_tozero_3D(variable%array3)
-    case (4) ; call Agrif_set_array_tozero_4D(variable%array4)
-    case (5) ; call Agrif_set_array_tozero_5D(variable%array5)
-    case (6) ; call Agrif_set_array_tozero_6D(variable%array6)
-    end select
-!---------------------------------------------------------------------------------------------------
-contains
-!---------------------------------------------------------------------------------------------------
-    subroutine Agrif_set_array_tozero_1D ( array )
-        real, dimension(:),           intent(out) :: array
-        array = 0.
-    end subroutine Agrif_set_array_tozero_1D
-!
-    subroutine Agrif_set_array_tozero_2D ( array )
-        real, dimension(:,:),         intent(out) :: array
-        array = 0.
-    end subroutine Agrif_set_array_tozero_2D
-!
-    subroutine Agrif_set_array_tozero_3D ( array )
-        real, dimension(:,:,:),       intent(out) :: array
-        array = 0.
-    end subroutine Agrif_set_array_tozero_3D
-!
-    subroutine Agrif_set_array_tozero_4D ( array )
-        real, dimension(:,:,:,:),     intent(out) :: array
-        array = 0.
-    end subroutine Agrif_set_array_tozero_4D
-!
-    subroutine Agrif_set_array_tozero_5D ( array )
-        real, dimension(:,:,:,:,:),   intent(out) :: array
-        array = 0.
-    end subroutine Agrif_set_array_tozero_5D
-!
-    subroutine Agrif_set_array_tozero_6D ( array )
-        real, dimension(:,:,:,:,:,:), intent(out) :: array
-        array = 0.
-    end subroutine Agrif_set_array_tozero_6D
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_var_set_array_tozero
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_var_copy_array
-!
-!> Copy a part of data array from var2 to var1
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_var_copy_array ( var1, inf1, sup1, var2, inf2, sup2, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),      intent(inout) :: var1    !< Modified variable
-    integer, dimension(nbdim), intent(in)    :: inf1    !< Lower boundary for var1
-    integer, dimension(nbdim), intent(in)    :: sup1    !< Upper boundary for var1
-    type(Agrif_Variable),      intent(in)    :: var2    !< Input variable
-    integer, dimension(nbdim), intent(in)    :: inf2    !< Lower boundary for var2
-    integer, dimension(nbdim), intent(in)    :: sup2    !< Upper boundary for var2
-    integer,                   intent(in)    :: nbdim   !< Dimension of the array
-!
-    select case (nbdim)
-    case (1) ; var1%array1(inf1(1):sup1(1)) = var2%array1(inf2(1):sup2(1))
-    case (2) ; call Agrif_copy_array_2d( var1%array2, var2%array2, &
-                                         lbound(var1%array2), lbound(var2%array2), inf1, sup1, inf2, sup2 )
-    case (3) ; call Agrif_copy_array_3d( var1%array3, var2%array3, &
-                                         lbound(var1%array3), lbound(var2%array3), inf1, sup1, inf2, sup2 )
-    case (4) ; call Agrif_copy_array_4d( var1%array4, var2%array4, &
-                                         lbound(var1%array4), lbound(var2%array4), inf1, sup1, inf2, sup2 )
-    case (5) ; var1%array5(inf1(1):sup1(1),   &
-                           inf1(2):sup1(2),   &
-                           inf1(3):sup1(3),   &
-                           inf1(4):sup1(4),   &
-                           inf1(5):sup1(5)) = var2%array5(inf2(1):sup2(1), &
-                                                          inf2(2):sup2(2), &
-                                                          inf2(3):sup2(3), &
-                                                          inf2(4):sup2(4), &
-                                                          inf2(5):sup2(5))
-    case (6) ; var1%array6(inf1(1):sup1(1),   &
-                           inf1(2):sup1(2),   &
-                           inf1(3):sup1(3),   &
-                           inf1(4):sup1(4),   &
-                           inf1(5):sup1(5),   &
-                           inf1(6):sup1(6)) = var2%array6(inf2(1):sup2(1), &
-                                                          inf2(2):sup2(2), &
-                                                          inf2(3):sup2(3), &
-                                                          inf2(4):sup2(4), &
-                                                          inf2(5):sup2(5), &
-                                                          inf2(6):sup2(6))
-    end select
-!---------------------------------------------------------------------------------------------------
-contains
-!---------------------------------------------------------------------------------------------------
-    subroutine Agrif_copy_array_2d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
-        integer, dimension(2), intent(in)   :: l, m
-        integer, dimension(2), intent(in)   :: inf1, sup1
-        integer, dimension(2), intent(in)   :: inf2, sup2
-        real, dimension(l(1):,l(2):), intent(out) :: tabout
-        real, dimension(m(1):,m(2):), intent(in)  :: tabin
-        tabout(inf1(1):sup1(1), &
-               inf1(2):sup1(2)) = tabin(inf2(1):sup2(1), &
-                                        inf2(2):sup2(2))
-    end subroutine Agrif_copy_array_2d
-!
-    subroutine Agrif_copy_array_3d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
-        integer, dimension(3), intent(in)   :: l, m
-        integer, dimension(3), intent(in)   :: inf1, sup1
-        integer, dimension(3), intent(in)   :: inf2,sup2
-        real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout
-        real, dimension(m(1):,m(2):,m(3):), intent(in)  :: tabin
-        tabout(inf1(1):sup1(1), &
-               inf1(2):sup1(2), &
-               inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), &
-                                        inf2(2):sup2(2), &
-                                        inf2(3):sup2(3))
-    end subroutine Agrif_copy_array_3d
-!
-    subroutine Agrif_copy_array_4d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
-        integer, dimension(4), intent(in)   :: l, m
-        integer, dimension(4), intent(in)   :: inf1, sup1
-        integer, dimension(4), intent(in)   :: inf2, sup2
-        real, dimension(l(1):,l(2):,l(3):,l(4):), intent(out) :: tabout
-        real, dimension(m(1):,m(2):,m(3):,m(4):), intent(in)  :: tabin
-        tabout(inf1(1):sup1(1), &
-               inf1(2):sup1(2), &
-               inf1(3):sup1(3), &
-               inf1(4):sup1(4)) = tabin(inf2(1):sup2(1), &
-                                        inf2(2):sup2(2), &
-                                        inf2(3):sup2(3), &
-                                        inf2(4):sup2(4))
-    end subroutine Agrif_copy_array_4d
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_var_copy_array
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_var_full_copy_array
-!
-!> Copy the full data array from var2 to var1
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_var_full_copy_array ( var1, var2, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), intent(inout) :: var1    !< Modified variable
-    type(Agrif_Variable), intent(in)    :: var2    !< Input variable
-    integer,              intent(in)    :: nbdim   !< Dimension of the array
-!
-    select case (nbdim)
-    case (1) ; var1 % array1 = var2 % array1
-    case (2) ; var1 % array2 = var2 % array2
-    case (3) ; var1 % array3 = var2 % array3
-    case (4) ; var1 % array4 = var2 % array4
-    case (5) ; var1 % array5 = var2 % array5
-    case (6) ; var1 % array6 = var2 % array6
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_var_full_copy_array
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine GiveAgrif_SpecialValueToTab_mpi
-!
-!> Copy \b value in data array \b var2 where it is present in \b var1.
-!---------------------------------------------------------------------------------------------------
-subroutine GiveAgrif_SpecialValueToTab_mpi ( var1, var2, bounds, value, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),      intent(in)    :: var1    !< Modified variable
-    type(Agrif_Variable),      intent(inout) :: var2    !< Input variable
-    integer, dimension(:,:,:), intent(in)    :: bounds  !< Bound for both arrays
-    real,                      intent(in)    :: value   !< Special value
-    integer,                   intent(in)    :: nbdim   !< Dimension of the array
-!
-    select case (nbdim)
-    case (1)
-        where (var1 % array1(bounds(1,1,2):bounds(1,2,2)) == value )
-            var2 % array1(bounds(1,1,1):bounds(1,2,1)) = value
-        end where
-    case (2)
-        where (var1 % array2(bounds(1,1,2):bounds(1,2,2), &
-                             bounds(2,1,2):bounds(2,2,2)) == value)
-            var2 % array2(bounds(1,1,1):bounds(1,2,1), &
-                          bounds(2,1,1):bounds(2,2,1)) = value
-        end where
-    case (3)
-        where (var1 % array3(bounds(1,1,2):bounds(1,2,2), &
-                             bounds(2,1,2):bounds(2,2,2), &
-                             bounds(3,1,2):bounds(3,2,2)) == value)
-            var2 % array3(bounds(1,1,1):bounds(1,2,1), &
-                          bounds(2,1,1):bounds(2,2,1), &
-                          bounds(3,1,1):bounds(3,2,1)) = value
-        end where
-    case (4)
-        where (var1 % array4(bounds(1,1,2):bounds(1,2,2), &
-                             bounds(2,1,2):bounds(2,2,2), &
-                             bounds(3,1,2):bounds(3,2,2), &
-                             bounds(4,1,2):bounds(4,2,2)) == value)
-            var2 % array4(bounds(1,1,1):bounds(1,2,1), &
-                          bounds(2,1,1):bounds(2,2,1), &
-                          bounds(3,1,1):bounds(3,2,1), &
-                          bounds(4,1,1):bounds(4,2,1)) = value
-        end where
-    case (5)
-        where (var1 % array5(bounds(1,1,2):bounds(1,2,2), &
-                             bounds(2,1,2):bounds(2,2,2), &
-                             bounds(3,1,2):bounds(3,2,2), &
-                             bounds(4,1,2):bounds(4,2,2), &
-                             bounds(5,1,2):bounds(5,2,2)) == value)
-            var2 % array5(bounds(1,1,1):bounds(1,2,1), &
-                          bounds(2,1,1):bounds(2,2,1), &
-                          bounds(3,1,1):bounds(3,2,1), &
-                          bounds(4,1,1):bounds(4,2,1), &
-                          bounds(5,1,1):bounds(5,2,1)) = value
-        end where
-    case (6)
-        where (var1 % array6(bounds(1,1,2):bounds(1,2,2), &
-                             bounds(2,1,2):bounds(2,2,2), &
-                             bounds(3,1,2):bounds(3,2,2), &
-                             bounds(4,1,2):bounds(4,2,2), &
-                             bounds(5,1,2):bounds(5,2,2), &
-                             bounds(6,1,2):bounds(6,2,2)) == value)
-            var2 % array6(bounds(1,1,1):bounds(1,2,1), &
-                          bounds(2,1,1):bounds(2,2,1), &
-                          bounds(3,1,1):bounds(3,2,1), &
-                          bounds(4,1,1):bounds(4,2,1), &
-                          bounds(5,1,1):bounds(5,2,1), &
-                          bounds(6,1,1):bounds(6,2,1)) = value
-        end where
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine GiveAgrif_SpecialValueToTab_mpi
-!===================================================================================================
-!
-! no more used ???
-#if 0
-!===================================================================================================
-!  subroutine GiveAgrif_SpecialValueToTab
-!---------------------------------------------------------------------------------------------------
-subroutine GiveAgrif_SpecialValueToTab ( var1, var2, &
-                                         lower, upper, Value, nbdim )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Variable),      pointer      :: var1
-    TYPE(Agrif_Variable),      pointer      :: var2
-    INTEGER,                   intent(in)   :: nbdim
-    INTEGER, DIMENSION(nbdim), intent(in)   :: lower, upper
-    REAL,                      intent(in)   :: Value
-!
-    select case (nbdim)
-    case (1)
-        where (var1 % array1( lower(1):upper(1)) == Value)
-            var2 % array1(lower(1):upper(1)) = Value
-        end where
-    case (2)
-        where (var1 % array2( lower(1):upper(1), &
-                                   lower(2):upper(2)) == Value)
-            var2 % array2(lower(1):upper(1), &
-                               lower(2):upper(2)) = Value
-        end where
-    case (3)
-        where (var1 % array3( lower(1):upper(1), &
-                                   lower(2):upper(2), &
-                                   lower(3):upper(3)) == Value)
-            var2 % array3(lower(1):upper(1), &
-                               lower(2):upper(2), &
-                               lower(3):upper(3)) = Value
-        end where
-    case (4)
-        where (var1 % array4( lower(1):upper(1), &
-                                   lower(2):upper(2), &
-                                   lower(3):upper(3), &
-                                   lower(4):upper(4)) == Value)
-            var2 % array4(lower(1):upper(1), &
-                               lower(2):upper(2), &
-                               lower(3):upper(3), &
-                               lower(4):upper(4)) = Value
-        end where
-    case (5)
-        where (var1 % array5( lower(1):upper(1), &
-                                   lower(2):upper(2), &
-                                   lower(3):upper(3), &
-                                   lower(4):upper(4), &
-                                   lower(5):upper(5)) == Value)
-            var2 % array5(lower(1):upper(1), &
-                               lower(2):upper(2), &
-                               lower(3):upper(3), &
-                               lower(4):upper(4), &
-                               lower(5):upper(5)) = Value
-        end where
-    case (6)
-        where (var1 % array6( lower(1):upper(1), &
-                                   lower(2):upper(2), &
-                                   lower(3):upper(3), &
-                                   lower(4):upper(4), &
-                                   lower(5):upper(5), &
-                                   lower(6):upper(6)) == Value)
-            var2 % array6(lower(1):upper(1), &
-                               lower(2):upper(2), &
-                               lower(3):upper(3), &
-                               lower(4):upper(4), &
-                               lower(5):upper(5), &
-                               lower(6):upper(6)) = Value
-        end where
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine GiveAgrif_SpecialValueToTab
-!===================================================================================================
-#endif
-!
-#if defined AGRIF_MPI
-!===================================================================================================
-!  subroutine Agrif_var_replace_value
-!
-!> Replace \b value by \var2 content in \var1 data array.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_var_replace_value ( var1, var2, lower, upper, value, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),      intent(inout) :: var1    !< Modified variable
-    type(Agrif_Variable),      intent(in)    :: var2    !< Input variable
-    integer, dimension(nbdim), intent(in)    :: lower   !< Lower bound
-    integer, dimension(nbdim), intent(in)    :: upper   !< Upper bound
-    real,                      intent(in)    :: value   !< Special value
-    integer,                   intent(in)    :: nbdim   !< Dimension of the array
-!
-    integer :: i,j,k,l,m,n
-!
-    select case (nbdim)
-    case (1)
-        do i = lower(1),upper(1)
-            if (var1%array1(i) == value) then
-                var1%array1(i) = var2%array1(i)
-            endif
-        enddo
-    case (2)
-        do j = lower(2),upper(2)
-        do i = lower(1),upper(1)
-            if (var1%array2(i,j) == value) then
-                var1%array2(i,j) = var2%array2(i,j)
-            endif
-        enddo
-        enddo
-    case (3)
-        do k = lower(3),upper(3)
-        do j = lower(2),upper(2)
-        do i = lower(1),upper(1)
-            if (var1%array3(i,j,k) == value) then
-                var1%array3(i,j,k) = var2%array3(i,j,k)
-            endif
-        enddo
-        enddo
-        enddo
-    case (4)
-        do l = lower(4),upper(4)
-        do k = lower(3),upper(3)
-        do j = lower(2),upper(2)
-        do i = lower(1),upper(1)
-            if (var1%array4(i,j,k,l) == value) then
-                var1%array4(i,j,k,l) = var2%array4(i,j,k,l)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
-    case (5)
-        do m = lower(5),upper(5)
-        do l = lower(4),upper(4)
-        do k = lower(3),upper(3)
-        do j = lower(2),upper(2)
-        do i = lower(1),upper(1)
-            if (var1%array5(i,j,k,l,m) == value) then
-                var1%array5(i,j,k,l,m) = var2%array5(i,j,k,l,m)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-    case (6)
-        do n = lower(6),upper(6)
-        do m = lower(5),upper(5)
-        do l = lower(4),upper(4)
-        do k = lower(3),upper(3)
-        do j = lower(2),upper(2)
-        do i = lower(1),upper(1)
-            if (var1%array6(i,j,k,l,m,n) == value) then
-                var1%array6(i,j,k,l,m,n) = var2%array6(i,j,k,l,m,n)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_var_replace_value
-!===================================================================================================
-#endif
-!
-!===================================================================================================
-!  subroutine PreProcessToInterpOrUpdate
-!---------------------------------------------------------------------------------------------------
-subroutine PreProcessToInterpOrUpdate ( parent, child,              &
-                                        nb_child, ub_child,         &
-                                        lb_child, lb_parent,        &
-                                        s_child,  s_parent,         &
-                                        ds_child, ds_parent, nbdim, interp )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), pointer, intent(in)   :: parent       !< Variable on the parent grid
-    type(Agrif_Variable), pointer, intent(in)   :: child        !< Variable on the child grid
-    integer, dimension(6), intent(out)          :: nb_child     !< Number of cells on the child grid
-    integer, dimension(6), intent(out)          :: ub_child     !< Upper bound on the child grid
-    integer, dimension(6), intent(out)          :: lb_child     !< Lower bound on the child grid
-    integer, dimension(6), intent(out)          :: lb_parent    !< Lower bound on the parent grid
-    real, dimension(6),    intent(out)          :: s_child      !< Child  grid position (s_root = 0)
-    real, dimension(6),    intent(out)          :: s_parent     !< Parent grid position (s_root = 0)
-    real, dimension(6),    intent(out)          :: ds_child     !< Child  grid dx (ds_root = 1)
-    real, dimension(6),    intent(out)          :: ds_parent    !< Parent grid dx (ds_root = 1)
-    integer,               intent(out)          :: nbdim        !< Number of dimensions
-    logical,               intent(in)           :: interp       !< .true. if preprocess for interpolation, \n
-                                                                !! .false. if preprocess for update
-!
-    type(Agrif_Variable), pointer :: root_var
-    type(Agrif_Grid),     pointer :: Agrif_Child_Gr
-    type(Agrif_Grid),     pointer :: Agrif_Parent_Gr
-    integer :: n
-!
-    Agrif_Child_Gr  => Agrif_Curgrid
-    Agrif_Parent_Gr => Agrif_Curgrid % parent
-!
-    root_var => child % root_var
-!
-!   Number of dimensions of the current grid
-    nbdim = root_var % nbdim
-!
-    do n = 1,nbdim
-!
-!       Value of interptab(n) can be either x,y,z or N for a no space dimension
-        select case(root_var % interptab(n))
-!
-        case('x')
-!
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
-            nb_child(n)  = Agrif_Child_Gr % nb(1)
-            s_child(n)   = Agrif_Child_Gr  % Agrif_x(1)
-            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(1)
-            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(1)
-            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(1)
-!
-            if ( root_var % posvar(n) == 1 ) then
-                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1)
-            else
-                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1
-                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
-                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
-            endif
-!
-        case('y')
-!
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
-            nb_child(n)  = Agrif_Child_Gr % nb(2)
-            s_child(n)   = Agrif_Child_Gr  % Agrif_x(2)
-            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(2)
-            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(2)
-            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(2)
-!
-            if (root_var % posvar(n)==1) then
-                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2)
-            else
-                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1
-                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
-                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
-            endif
-!
-        case('z')
-!
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
-            nb_child(n)  = Agrif_Child_Gr % nb(3)
-            s_child(n)   = Agrif_Child_Gr  % Agrif_x(3)
-            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(3)
-            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(3)
-            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(3)
-!
-            if (root_var % posvar(n)==1) then
-                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3)
-            else
-                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3) - 1
-                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
-                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
-            endif
-!
-        case('N') ! No space dimension
-!
-!       The next coefficients are calculated in order to do a simple copy of
-!       values of the grid variable when the interpolation routine is
-!       called for this dimension.
-!
-            if (interp) then
-                call Agrif_get_var_bounds(parent, lb_child(n), ub_child(n), n)
-                nb_child(n) = parent % ub(n) - parent % lb(n)
-            else
-                call Agrif_get_var_bounds(child,  lb_child(n), ub_child(n), n)
-                nb_child(n) = child % ub(n) - child % lb(n)
-            endif
-!
-!           No interpolation but only a copy of the values of the grid variable
-            lb_parent(n) = lb_child(n)
-            s_child(n)   = 0.
-            s_parent(n)  = 0.
-            ds_child(n)  = 1.
-            ds_parent(n) = 1.
-!
-        end select
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine PreProcessToInterpOrUpdate
-!===================================================================================================
-!
-#if defined AGRIF_MPI
-!===================================================================================================
-!   subroutine Agrif_GetLocalBoundaries
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_GetLocalBoundaries ( tab1, tab2, coord, lb, ub, deb, fin )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     ::  tab1
-    integer, intent(in)     ::  tab2
-    integer, intent(in)     ::  coord
-    integer, intent(in)     ::  lb, ub
-    integer, intent(out)    ::  deb, fin
-!
-    integer :: imin, imax
-    integer :: i1, i2
-!
-    call Agrif_InvLoc(lb, AGRIF_ProcRank, coord, imin)
-    call Agrif_InvLoc(ub, AGRIF_ProcRank, coord, imax)
-!
-    if ( imin > tab2 ) then
-        i1 = imax - imin
-    else
-        i1 = max(tab1 - imin,0)
-    endif
-!
-    if (imax < tab1) then
-        i2 = -(imax - imin)
-    else
-        i2 = min(tab2 - imax,0)
-    endif
-!
-    deb = lb + i1
-    fin = ub + i2
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_GetLocalBoundaries
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_GlobalToLocalBounds
-!
-!> For a global index located on the current processor, tabarray gives the corresponding local index
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_GlobalToLocalBounds ( locbounds, lb_var, ub_var, lb_glob, ub_glob,    &
-                                       coords, nbdim, rank, member )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(nbdim,2,2), intent(out)   :: locbounds   !< Local values of \b lb_glob and \b ub_glob
-    integer, dimension(nbdim),     intent(in)    :: lb_var      !< Local lower boundary on the current processor
-    integer, dimension(nbdim),     intent(in)    :: ub_var      !< Local upper boundary on the current processor
-    integer, dimension(nbdim),     intent(in)    :: lb_glob     !< Global lower boundary
-    integer, dimension(nbdim),     intent(in)    :: ub_glob     !< Global upper boundary
-    integer, dimension(nbdim),     intent(in)    :: coords
-    integer,                       intent(in)    :: nbdim       !< Dimension of the array
-    integer,                       intent(in)    :: rank        !< Rank of the processor
-    logical,                       intent(out)   :: member
-!
-    integer     :: i, i1, k
-    integer     :: nbloc(nbdim)
-!
-    locbounds(:,1,:) =  HUGE(1)
-    locbounds(:,2,:) = -HUGE(1)
-!
-    nbloc = 0
-!
-    do i = 1,nbdim
-!
-        call Agrif_InvLoc(lb_var(i), rank, coords(i), i1)
-!
-        do k = lb_glob(i)+lb_var(i)-i1,ub_glob(i)+lb_var(i)-i1
-!
-            if ( (k >= lb_var(i)) .AND. (k <= ub_var(i)) ) then
-                nbloc(i) = 1
-                locbounds(i,1,1) = min(locbounds(i,1,1),k-lb_var(i)+i1)
-                locbounds(i,2,1) = max(locbounds(i,2,1),k-lb_var(i)+i1)
-
-                locbounds(i,1,2) = min(locbounds(i,1,2),k)
-                locbounds(i,2,2) = max(locbounds(i,2,2),k)
-            endif
-        enddo
-    enddo
-
-    member = ( sum(nbloc) == nbdim )
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_GlobalToLocalBounds
-!===================================================================================================
-#endif
-!
-end module Agrif_Arrays
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 10251)
@@ -0,0 +1,1337 @@
+!
+! $Id: modbc.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Boundary 
+C 
+      Module Agrif_Boundary  
+C
+CCC   Description:
+CCC   Module to calculate the boundary conditions on the child grids from their
+CCC   parent grids.
+C
+C     Modules used:  
+C   
+      Use Agrif_Interpolation        
+C
+      IMPLICIT NONE
+C        
+      CONTAINS   
+C     Define procedures contained in this module
+C
+C
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_1d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 1D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations are
+                                            ! done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1) 
+     &    ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for  
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
+C     variable.   
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var
+C      
+C     Values of the grid variable
+      childtemp % var % parray1 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation 
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub         
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+
+C   
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp
+C         
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_1D
+C
+      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 2D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations are
+                                            ! done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2) 
+     &    ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for  
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
+C     variable.   
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var
+C      
+C     Values of the grid variable
+      childtemp % var % parray2 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation 
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub         
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+
+C   
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp
+C         
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_3d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 3D 
+CCC   variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments 
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations 
+                                            ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for 
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var       
+C      
+C     Values of the grid variable
+      childtemp % var % parray3 => tab
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation  
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub
+C
+C     Call to the procedure for the calculations of the boundary conditions     
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_3D               
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_4d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 4D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &        ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray4 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade  
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub               
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_5d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 5D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray5 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp  
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub
+                     
+C
+C     Call to the procedure for the calculations of the boundary conditions  
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_5D
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_6d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 6D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray6 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp  
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub               
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_6D
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CorrectVariable
+C     **************************************************************************
+C
+      Subroutine AGRIF_CorrectVariable(TypeInterp,parent,child,deb,fin,
+     &                                 pweight,weight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      INTEGER,DIMENSION(6,6)  :: TypeInterp     ! TYPE of interpolation
+                                              !    (linear,lagrange,...)
+      INTEGER               :: deb,fin        ! Positions where boundary
+                                              !    conditions are calculated
+      LOGICAL               :: pweight        ! Indicates if weight is used 
+                                              !    for the time interpolation 
+      REAL                  :: weight         ! Coefficient for the time
+                                              !    interpolation
+C
+C     Local scalars
+      TYPE(Agrif_Grid)    , Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
+      TYPE(AGRIF_Variable), Pointer :: root   ! Variable on the root grid
+      INTEGER                       :: nbdim  ! Number of dimensions of 
+                                              !    the grid variable 
+      INTEGER                       :: n
+      INTEGER,DIMENSION(6)          :: pttab_child  ! Index of the first point
+                                                    !    inside the domain for
+                                                    !    the child grid variable
+      INTEGER,DIMENSION(6)          :: pttab_parent ! Index of the first point
+                                                    !    inside the domain for
+                                                    !    the parent grid
+                                                    !    variable
+      INTEGER,DIMENSION(6)          :: nbtab_Child  ! Number of the cells
+      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
+                                                    !    variable on the cell 
+      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
+                                                    !    grid has a common
+                                                    !    border with the root
+                                                    !    grid      
+      REAL, DIMENSION(6)            :: s_child,s_parent   ! Positions of the
+                                                    !    parent and child grids
+      REAL, DIMENSION(6)            :: ds_child,ds_parent ! Space steps of the
+                                                    !    parent and child grids 
+C
+C
+      loctab_child(:) = 0
+C
+      Agrif_Child_Gr => Agrif_Curgrid
+      Agrif_Parent_Gr => Agrif_Curgrid % parent
+      root => child % var % root_var 
+      nbdim = root % nbdim
+C
+      do n = 1,nbdim
+        posvartab_child(n) = root % posvar(n)      
+      enddo
+C
+C
+      do n = 1,nbdim
+C
+        Select case(root % interptab(n))
+C
+          case('x') ! x DIMENSION
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(1)
+            pttab_Child(n) = root % point(1)
+            pttab_Parent(n) = root % point(1)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
+            if (root % posvar(n) == 2) then
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif
+C
+            if (Agrif_CURGRID % NearRootBorder(1)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(1))
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(1)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(1))) 
+     &         loctab_child(n) = -3
+C
+          case('y') ! y DIMENSION      
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(2)
+            pttab_Child(n) = root % point(2)
+            pttab_Parent(n) = root % point(2)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
+            if (root % posvar(n) == 2) then        
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif        
+C
+            if (Agrif_CURGRID % NearRootBorder(2)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(2)) 
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(2)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(2))) 
+     &         loctab_child(n) = -3
+C
+          case('z') ! z DIMENSION
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(3)
+            pttab_Child(n) = root % point(3)
+            pttab_Parent(n) = root % point(3)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
+            if (root % posvar(n) == 2) then        
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif        
+C
+            if (Agrif_CURGRID % NearRootBorder(3)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(3)) 
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(3)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(3))) 
+     &         loctab_child(n) = -3
+C
+          case('N') ! No space DIMENSION      
+C
+            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
+            pttab_Child(n) = child % var % lb(n)
+C
+C           No interpolation but only a copy of the values of the grid variable
+C      
+            posvartab_child(n) = 1
+            pttab_Parent(n)= pttab_Child(n)
+            s_Child(n)=0.
+            s_Parent(n)=0. 
+            ds_Child(n)=1.
+            ds_Parent(n)=1.
+            loctab_child(n) = -3
+C
+        End select
+C
+      enddo
+C
+         IF (present(procname)) THEN
+          Call AGRIF_CorrectnD
+     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)
+        ELSE
+          Call AGRIF_CorrectnD
+     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ENDIF
+C
+C
+      End subroutine AGRIF_CorrectVariable
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Correctnd
+C     **************************************************************************
+C
+      Subroutine AGRIF_Correctnd(TypeInterp,parent,child,deb,fin,
+     &                           pweight,weight,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+      INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp ! TYPE of interpolation (linear, 
+                                         !   spline,...)  
+      TYPE(AGRIF_PVariable)    :: parent ! Variable on the parent grid
+      TYPE(AGRIF_PVariable)    :: child  ! Variable on the child grid 
+      INTEGER                  :: deb,fin ! Positions where interpolations 
+                                         !    are done
+      LOGICAL                  :: pweight ! Indicates if weight is used for 
+                                         !    the temporal interpolation
+      REAL                     :: weight ! Coefficient for the temporal
+                                         !    interpolation
+      INTEGER                  :: nbdim  ! Number of dimensions of the grid
+                                         !    variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child ! Index of the first point inside
+                                         !    the domain for the parent 
+                                         !    grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent ! Index of the first point 
+                                         !   inside the domain for the 
+                                         !   child grid variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child ! Number of cells of the child
+                                         !    grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child ! Position of the grid
+                                         !    variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child ! Indicates if the child 
+                                        !    grid has a common border with 
+                                        !    the root grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent ! Positions of the parent 
+                                        !   and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the 
+                                        !    parent and child grids
+C
+C     Local variables
+      TYPE(AGRIF_PVariable)        :: restore ! Variable on the parent     
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i          
+      INTEGER                      :: kindex  ! Index used for safeguard 
+                                       !    and time interpolation
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab ! Arrays indicating the limits 
+                                       !    of the child     
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab ! grid variable where 
+                                       !   boundary conditions are 
+      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres,ptres2 ! calculated
+      INTEGER                      :: nb,ndir,n,sizetab(1)
+      REAL, DIMENSION(:), Allocatable :: tab ! Array used for the interpolation
+      REAL    :: c1t,c2t               ! Coefficients for the time interpolation
+                                       !    (c2t=1-c1t) 
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lower,upper
+      INTEGER,DIMENSION(nbdim)   :: ltab,utab
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif            
+C      
+C
+      indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim)
+     &          + deb
+      indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( fin - deb )
+       
+      indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - fin
+      indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - deb
+                  
+      WHERE (posvartab_child(1:nbdim) == 2)
+        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
+        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
+      END WHERE
+      
+
+#if !defined key_mpp_mpi
+      Call Agrif_nbdim_Get_bound_dimension(child%var,lubglob(:,1),
+     &              lubglob(:,2),nbdim)
+C
+#else
+C     
+      Call Agrif_nbdim_Get_bound_dimension(child%var,lb,ub,nbdim)
+      
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)  
+     
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C     
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
+     &     lubglob(1:nbdim,2))
+      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
+     &     lubglob(1:nbdim,2))
+
+                              
+C 
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2      
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then
+C           
+              do n = 1,2
+C
+                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)  
+C
+              enddo              
+C
+              do i = 1,nbdim
+C     
+                if (i .NE. nb) then      
+C
+                    if (loctab_child(i) == -1 
+     &                                 .OR. loctab_child(i) == -3) then
+C
+                        ptres(i,1,ndir,nb) = pttab_child(i)
+C
+                      else
+C
+                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+C
+                    endif
+C
+                    if (loctab_child(i) == -2 
+     &                                 .OR. loctab_child(i) == -3) then
+C
+                        if (posvartab_child(i) == 1) then
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i)
+     &                                                 + nbtab_child(i)
+C
+                          else
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i)
+     &                                             + nbtab_child(i) - 1
+C
+                        endif                             
+C
+                      else
+C
+                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+C
+                    endif                        
+C      
+                endif
+C      
+              enddo
+      
+C
+#if defined key_mpp_mpi
+                 Call Agrif_nbdim_Get_bound_dimension
+     &                    (child%var,lower,upper,nbdim)
+
+              do i = 1,nbdim
+C
+                 Call GetLocalBoundaries(ptres(i,1,ndir,nb),
+     &                                  ptres(i,2,ndir,nb),i,
+     &                                  lower(i),upper(i),
+     &                                  ltab(i),utab(i))
+                 ptres2(i,1,ndir,nb) = max(ltab(i),lower(i)) 
+                 ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
+                 if ((i == nb) .AND. (ndir == 1)) then 
+                     ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
+                 elseif ((i == nb) .AND. (ndir == 2)) then
+                     ptres2(i,1,ndir,nb) = min(ltab(i),upper(i)) 
+                 endif
+C
+              enddo
+#else
+              ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
+#endif      
+            
+        endif
+      
+        enddo
+       enddo
+C
+      if (child % var % interpIndex 
+     &        /= Agrif_Curgrid % parent % ngridstep .OR.
+     &    child%var%Interpolationshouldbemade ) then
+C
+C     Space interpolation 
+C      
+      kindex = 1    
+      
+
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then  
+C
+              IF (present(procname)) THEN
+              Call Agrif_InterpnD
+     &             (TYPEInterp(nb,:),parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              restore,.FALSE.,nbdim,procname)
+              ELSE
+              Call Agrif_InterpnD              
+     &             (TYPEInterp(nb,:),parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              restore,.FALSE.,nbdim)
+              ENDIF
+     
+              IF (.NOT. child%var%interpolationshouldbemade) THEN
+C     
+C             Safeguard of the values of the grid variable (at times n and n+1
+C                on the parent grid)
+C      
+              sizetab(1) = 1
+C
+              do i = 1,nbdim
+C          
+                sizetab(1) = sizetab(1)
+     &              * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
+C      
+              enddo
+
+              Call saveAfterInterp(child,
+     &           ptres2(:,:,ndir,nb),kindex,sizetab(1),nbdim)
+C
+           ENDIF
+C
+          endif
+C
+        enddo       
+C
+      enddo     
+C
+C
+      child % var % interpIndex = Agrif_Curgrid % parent % ngridstep
+C
+C
+      endif  
+      
+              IF (.NOT. child%var%interpolationshouldbemade) THEN
+C
+C
+C     Calculation of the coefficients c1t and c2t for the temporary
+C        interpolation
+      if (pweight) then
+C
+          c1t = weight
+C
+        else
+C
+          c1t = (REAL(AGRIF_Nbstepint()) + 1.) / Agrif_Rhot()
+C
+      endif
+C                                  
+      c2t = 1. - c1t
+C           
+C     Time interpolation
+C
+      kindex = 1
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2      
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then
+
+              Call timeInterpolation
+     &             (child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
+          endif
+C
+        enddo
+C      
+      enddo
+C      
+
+       ENDIF
+C  
+      End Subroutine Agrif_Correctnd
+C
+C
+C     **************************************************************************
+CCC   Subroutine saveAfterInterp
+C     **************************************************************************
+C
+      Subroutine saveAfterInterp(child,bounds,kindex,newsize,nbdim)
+C
+CCC   Descritpion:
+CCC   Subroutine used to save the values of the grid variable on the fine grid 
+CCC   after the space interpolation. 
+C
+C     Declarations:
+C
+      
+C
+C     argument
+      TYPE (AGRIF_PVariable) :: child   ! The fine grid variable
+      INTEGER                :: kindex  ! Index indicating where this safeguard 
+                                        ! is done on the fine grid
+      INTEGER :: nbdim, newsize
+      INTEGER,DIMENSION(nbdim,2) :: bounds
+C
+C     Local scalars
+      INTEGER                      :: ir,jr,kr,lr,mr,nr
+C
+C
+C     Allocation of the array oldvalues2d
+
+C
+      if (newsize .LE. 0) return
+C
+      Call Agrif_Checksize
+     &     (child,kindex+newsize)  
+
+      if (child % var % interpIndex 
+     &        /= Agrif_Curgrid % parent % ngridstep ) then
+       child%var%oldvalues2d(1,kindex:kindex+newsize-1)=
+     &        child%var%oldvalues2d(2,kindex:kindex+newsize-1)
+      endif
+
+      SELECT CASE (nbdim)
+      CASE (1)
+
+!CDIR ALTCODE
+         do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray1(ir)
+            kindex = kindex + 1
+         enddo       
+C
+      CASE (2)
+
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+           do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray2(ir,jr)
+            kindex = kindex + 1
+           enddo
+         enddo      
+C
+      CASE (3)
+        do kr=bounds(3,1),bounds(3,2)
+          do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+             do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray3(ir,jr,kr)
+            kindex = kindex + 1
+             enddo
+           enddo
+         enddo       
+C
+      CASE (4)
+          do lr=bounds(4,1),bounds(4,2)
+           do kr=bounds(3,1),bounds(3,2)
+             do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+               do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray4(ir,jr,kr,lr)
+            kindex = kindex + 1
+               enddo
+             enddo
+           enddo
+         enddo         
+C
+      CASE (5)
+         do mr=bounds(5,1),bounds(5,2)
+           do lr=bounds(4,1),bounds(4,2)
+            do kr=bounds(3,1),bounds(3,2) 
+              do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                 do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray5(ir,jr,kr,lr,mr)
+            kindex = kindex + 1
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo   
+C
+      CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+           do mr=bounds(5,1),bounds(5,2)
+             do lr=bounds(4,1),bounds(4,2)
+               do kr=bounds(3,1),bounds(3,2)
+                do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                   do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray6(ir,jr,kr,lr,mr,nr)
+            kindex = kindex + 1
+                   enddo
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo       
+      END SELECT
+C
+C                                                  
+      End subroutine saveAfterInterp
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine timeInterpolation
+C     **************************************************************************
+C
+      Subroutine timeInterpolation(child,bounds,kindex,c1t,c2t,nbdim) 
+C
+CCC   Descritpion:
+CCC   Subroutine for a linear time interpolation on the child grid. 
+C
+C     Declarations:
+C
+      
+C
+C     argument
+      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,2) :: bounds
+      INTEGER                :: kindex ! Index indicating the values of the fine
+                                       ! grid got before and after the space 
+                                       ! interpolation and used for the time 
+                                       ! interpolation
+      REAL                   :: c1t,c2t! coefficients for the time interpolation
+                                       ! (c2t=1-c1t)  
+C
+C     Local aruments      
+      INTEGER :: i
+C     Local scalars
+      INTEGER                      :: ir,jr,kr,lr,mr,nr      
+C
+C
+      
+      SELECT CASE (nbdim)
+      CASE (1)
+
+!CDIR ALTCODE
+         do ir=bounds(1,1),bounds(1,2)
+                child%var%parray1(ir) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex)    
+            kindex = kindex + 1
+         enddo       
+C
+      CASE (2)
+
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+           do ir=bounds(1,1),bounds(1,2)
+                child%var%parray2(ir,jr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+           enddo
+         enddo      
+C
+      CASE (3)
+        do kr=bounds(3,1),bounds(3,2)
+          do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+             do ir=bounds(1,1),bounds(1,2)
+                child%var%parray3(ir,jr,kr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+             enddo
+           enddo
+         enddo       
+C
+      CASE (4)
+          do lr=bounds(4,1),bounds(4,2)
+           do kr=bounds(3,1),bounds(3,2)
+             do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+               do ir=bounds(1,1),bounds(1,2)
+                child%var%parray4(ir,jr,kr,lr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+               enddo
+             enddo
+           enddo
+         enddo         
+C
+      CASE (5)
+         do mr=bounds(5,1),bounds(5,2)
+           do lr=bounds(4,1),bounds(4,2)
+            do kr=bounds(3,1),bounds(3,2) 
+              do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                 do ir=bounds(1,1),bounds(1,2)
+                child%var%parray5(ir,jr,kr,lr,mr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo   
+C
+      CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+           do mr=bounds(5,1),bounds(5,2)
+             do lr=bounds(4,1),bounds(4,2)
+               do kr=bounds(3,1),bounds(3,2)
+                do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                   do ir=bounds(1,1),bounds(1,2)
+                child%var%parray6(ir,jr,kr,lr,mr,nr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+                   enddo
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo       
+      END SELECT
+                                                   
+C
+C
+      End subroutine timeInterpolation      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Checksize
+C     **************************************************************************
+C
+      Subroutine Agrif_Checksize(child,newsize)
+C
+CCC   Descritpion:
+CCC   Subroutine used in the saveAfterInterp procedure to allocate the 
+CCC   oldvalues2d array. 
+C
+C     Declarations:
+C
+      
+C      
+C     TYPE argument
+      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
+C 
+C     Scalar arguments
+      INTEGER :: newsize               ! Size of the domains where the boundary 
+                                       ! conditions are calculated  
+C
+C     Local arrays
+      REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
+C                
+C
+      if (.NOT. associated(child % var % oldvalues2d)) then
+C
+          allocate(child % var % oldvalues2d(2,newsize))
+C  
+          child % var % oldvalues2d=0.
+C
+        else
+C
+          if (SIZE(child % var % oldvalues2d,2) < newsize) then   
+C
+              allocate(tempoldvalues(2,SIZE(child % var %
+     &                                    oldvalues2d,2)))
+C
+              tempoldvalues = child % var % oldvalues2d
+C
+              deallocate(child % var % oldvalues2d)
+C
+              allocate(child % var % oldvalues2d(2,newsize))
+C            
+              child%var%oldvalues2d=0.
+C
+              child % var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = 
+     &        tempoldvalues(:,:)
+C
+              deallocate(tempoldvalues)
+C
+          endif 
+C
+      endif                                                    
+C
+C
+      End  Subroutine Agrif_Checksize
+C
+C
+C
+C      
+      End Module AGRIF_boundary
+
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 10250)
+++ 	(revision )
@@ -1,649 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_Boundary.
-!>
-!> Contains subroutines to calculate the boundary conditions on the child grids from their
-!> parent grids.
-!
-module Agrif_Boundary
-!
-    use Agrif_Interpolation
-!
-    implicit none
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_CorrectVariable
-!
-!> subroutine to calculate the boundary conditions on a fine grid
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_CorrectVariable ( parent, child, pweight, weight, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
-    type(Agrif_Variable), pointer       :: child        !< Variable on the child grid
-    logical                             :: pweight      !< Indicates if weight is used for the time interpolation
-    real                                :: weight       !< Coefficient for the time interpolation
-    procedure()                         :: procname     !< Data recovery procedure
-!
-    type(Agrif_Grid)    , pointer :: Agrif_Child_Gr, Agrif_Parent_Gr
-    type(Agrif_Variable), pointer :: root_var   ! Variable on the root grid
-    integer                :: nbdim  ! Number of dimensions of the grid variable
-    integer                :: n
-    integer, dimension(6)  :: lb_child       ! Index of the first point inside the domain for
-                                                !    the child grid variable
-    integer, dimension(6)  :: lb_parent      ! Index of the first point inside the domain for
-                                                !    the parent grid variable
-    integer, dimension(6)  :: ub_child     !  Upper bound on the child grid
-    integer, dimension(6)  :: nb_child       ! Number of cells for child
-    integer, dimension(6)  :: posvartab_child   ! Position of the variable on the cell
-    integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border
-                                                !    with the root grid
-    real, dimension(6)     :: s_child, s_parent   ! Positions of the parent and child grids
-    real, dimension(6)     :: ds_child, ds_parent ! Space steps of the parent and child grids
-!
-    call PreProcessToInterpOrUpdate( parent,   child,       &
-                                     nb_child, ub_child,    &
-                                     lb_child, lb_parent,   &
-                                      s_child,  s_parent,   &
-                                     ds_child, ds_parent, nbdim, interp=.true.)
-    root_var => child % root_var
-    Agrif_Child_Gr => Agrif_Curgrid
-    Agrif_Parent_Gr => Agrif_Curgrid % parent
-!
-    loctab_child(:) = 0
-    posvartab_child(1:nbdim) = root_var % posvar(1:nbdim)
-!
-    do n = 1,nbdim
-!
-        select case(root_var % interptab(n))
-!
-        case('x') ! x DIMENSION
-!
-            if (Agrif_Curgrid % NearRootBorder(1))      loctab_child(n) = -1
-            if (Agrif_Curgrid % DistantRootBorder(1))   loctab_child(n) = -2
-            if ((Agrif_Curgrid % NearRootBorder(1)) .AND. &
-                (Agrif_Curgrid % DistantRootBorder(1))) loctab_child(n) = -3
-!
-        case('y') ! y DIMENSION
-!
-            if (Agrif_Curgrid % NearRootBorder(2))      loctab_child(n) = -1
-            if (Agrif_Curgrid % DistantRootBorder(2))   loctab_child(n) = -2
-            if ((Agrif_Curgrid % NearRootBorder(2)) .AND. &
-                (Agrif_Curgrid % DistantRootBorder(2))) loctab_child(n) = -3
-!
-        case('z') ! z DIMENSION
-!
-            if (Agrif_Curgrid % NearRootBorder(3))      loctab_child(n) = -1
-            if (Agrif_Curgrid % DistantRootBorder(3))   loctab_child(n) = -2
-            if ((Agrif_Curgrid % NearRootBorder(3)) .AND. &
-                (Agrif_Curgrid % DistantRootBorder(3))) loctab_child(n) = -3
-!
-        case('N') ! No space DIMENSION
-!
-            posvartab_child(n) = 1
-            loctab_child(n) = -3
-!
-        end select
-!
-    enddo
-!
-    call Agrif_Correctnd(parent, child, pweight, weight,                    &
-                         lb_child(1:nbdim), lb_parent(1:nbdim),             &
-                         nb_child(1:nbdim), posvartab_child(1:nbdim),       &
-                         loctab_child(1:nbdim),                             &
-                         s_child(1:nbdim), s_parent(1:nbdim),               &
-                         ds_child(1:nbdim),ds_parent(1:nbdim), nbdim, procname )
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_CorrectVariable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Correctnd
-!
-!> calculates the boundary conditions for a nD grid variable on a fine grid by using
-!> a space and time interpolations; it is called by the #Agrif_CorrectVariable procedure
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Correctnd ( parent, child, pweight, weight,                        &
-                             pttab_child, pttab_Parent,                             &
-                             nbtab_Child, posvartab_Child, loctab_Child,            &
-                             s_Child, s_Parent, ds_Child, ds_Parent,                &
-                             nbdim, procname )
-!---------------------------------------------------------------------------------------------------
-#if defined AGRIF_MPI
-    include 'mpif.h'
-#endif
-!
-    TYPE(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
-    TYPE(Agrif_Variable), pointer       :: child        !< Variable on the child grid
-    LOGICAL                             :: pweight      !< Indicates if weight is used for the temporal interpolation
-    REAL                                :: weight       !< Coefficient for the temporal interpolation
-    INTEGER, DIMENSION(nbdim)   :: pttab_child          !< Index of the first point inside the domain for the parent grid variable
-    INTEGER, DIMENSION(nbdim)   :: pttab_Parent         !< Index of the first point inside the domain for the child  grid variable
-    INTEGER, DIMENSION(nbdim)   :: nbtab_Child          !< Number of cells of the child grid
-    INTEGER, DIMENSION(nbdim)   :: posvartab_Child      !< Position of the grid variable (1 or 2)
-    INTEGER, DIMENSION(nbdim)   :: loctab_Child         !< Indicates if the child grid has a common border with the root grid
-    REAL   , DIMENSION(nbdim)   :: s_Child,  s_Parent   !< Positions of the parent and child grids
-    REAL   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids
-    INTEGER                             :: nbdim        !< Number of dimensions of the grid variable
-    procedure()                         :: procname     !< Data recovery procedure
-!
-    INTEGER,DIMENSION(6)                :: type_interp     ! Type of interpolation (linear, spline,...)
-    INTEGER,DIMENSION(6,6)              :: type_interp_bc  ! Type of interpolation (linear, spline,...)
-    INTEGER,DIMENSION(nbdim,2,2)        :: childarray
-    INTEGER,DIMENSION(nbdim,2)          :: lubglob
-    INTEGER                             :: kindex       ! Index used for safeguard and time interpolation
-    INTEGER,DIMENSION(nbdim,2,2)        :: indtab       ! Arrays indicating the limits of the child
-    INTEGER,DIMENSION(nbdim,2,2)        :: indtruetab   ! grid variable where boundary conditions are
-    INTEGER,DIMENSION(nbdim,2,2,nbdim)  :: ptres,ptres2 ! calculated
-    INTEGER,DIMENSION(nbdim)            :: coords
-    INTEGER                             :: i, nb, ndir
-    INTEGER                             :: n, sizetab
-    INTEGER                             :: ibeg, iend
-    INTEGER                             :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2
-    REAL                                :: c1t,c2t      ! Coefficients for the time interpolation (c2t=1-c1t)
-#if defined AGRIF_MPI
-!
-    INTEGER, DIMENSION(nbdim)   :: lower, upper
-    INTEGER, DIMENSION(nbdim)   :: ltab, utab
-!
-#endif
-!
-    type_interp_bc = child % root_var % type_interp_bc
-    coords         = child % root_var % coords
-!
-    ibeg = child % bcinf
-    iend = child % bcsup
-!
-    indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim) + ibeg
-    indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( iend - ibeg )
-
-    indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - iend
-    indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - ibeg
-
-    WHERE (posvartab_child(1:nbdim) == 2)
-        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
-        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
-    END WHERE
-!
-    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
-!
-    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
-    indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2), lubglob(1:nbdim,1))
-    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2))
-    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2))
-!
-    do nb = 1,nbdim
-        do ndir = 1,2
-!
-            if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
-!
-                do n = 1,2
-                    ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
-                enddo
-!
-                do i = 1,nbdim
-!
-                    if (i /= nb) then
-!
-                        if (loctab_child(i) == -1 .OR. loctab_child(i) == -3) then
-                            ptres(i,1,ndir,nb) = pttab_child(i)
-                        else
-                            ptres(i,1,ndir,nb) = indtruetab(i,1,1)
-                        endif
-                        if (loctab_child(i) == -2 .OR. loctab_child(i) == -3) then
-                            if (posvartab_child(i) == 1) then
-                                ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i)
-                            else
-                                ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i) - 1
-                            endif
-                        else
-                            ptres(i,2,ndir,nb) = indtruetab(i,2,2)
-                        endif
-!
-                    endif
-!
-                enddo
-
-!
-#if defined AGRIF_MPI
-                call Agrif_get_var_bounds_array(child,lower,upper,nbdim)
-
-                do i = 1,nbdim
-!
-                    Call Agrif_GetLocalBoundaries(ptres(i,1,ndir,nb), ptres(i,2,ndir,nb),  &
-                                                  coords(i), lower(i), upper(i), ltab(i), utab(i) )
-                    ptres2(i,1,ndir,nb) = max(ltab(i),lower(i))
-                    ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
-                    if ((i == nb) .AND. (ndir == 1)) then
-                        ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
-                    elseif ((i == nb) .AND. (ndir == 2)) then
-                        ptres2(i,1,ndir,nb) = min(ltab(i),upper(i))
-                    endif
-!
-                enddo
-#else
-                ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
-#endif
-            endif
-!
-        enddo   ! ndir = 1,2
-    enddo       ! nb = 1,nbdim
-!
-    if ( child % interpIndex /= Agrif_Curgrid % parent % ngridstep .OR. &
-         child % Interpolationshouldbemade ) then
-!
-!     Space interpolation
-!
-        kindex = 1
-!
-        do nb = 1,nbdim
-
-            type_interp = type_interp_bc(nb,:)
-
-            do ndir = 1,2
-!
-                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
-!
-                    call Agrif_InterpnD(type_interp, parent, child,             &
-                                        ptres(1:nbdim,1,ndir,nb),               &
-                                        ptres(1:nbdim,2,ndir,nb),               &
-                                        pttab_child(1:nbdim),                   &
-                                        pttab_Parent(1:nbdim),                  &
-                                        s_Child(1:nbdim), s_Parent(1:nbdim),    &
-                                        ds_Child(1:nbdim),ds_Parent(1:nbdim),   &
-                                        NULL(), .FALSE., nbdim,                 &
-                                        childarray,                             &
-                                        child%memberin(nb,ndir), .TRUE., procname, coords(nb), ndir)
-
-                    child % childarray(1:nbdim,:,:,nb,ndir) = childarray
-
-                    if (.not. child%interpolationshouldbemade) then
-!
-!                       Safeguard of the values of the grid variable (at times n and n+1 on the parent grid)
-!
-                        sizetab = 1
-                        do i = 1,nbdim
-                            sizetab = sizetab * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
-                        enddo
-
-                        call saveAfterInterp(child,ptres2(:,:,ndir,nb),kindex,sizetab,nbdim)
-!
-                    endif
-!
-                endif
-!
-            enddo   ! ndir = 1,2
-        enddo       ! nb = 1,nbdim
-!
-        child % interpIndex = Agrif_Curgrid % parent % ngridstep
-!
-    endif
-!
-    if (.not. child%interpolationshouldbemade) then
-!
-!       Calculation of the coefficients c1t and c2t for the temporary interpolation
-!
-        if (pweight) then
-            c1t = weight
-        else
-            c1t = (REAL(Agrif_Nbstepint()) + 1.) / Agrif_Rhot()
-        endif
-        c2t = 1. - c1t
-!
-!       Time interpolation
-!
-        kindex = 1
-!
-        do nb = 1,nbdim
-            do ndir = 1,2
-                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
-                    Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
-                endif
-            enddo
-        enddo
-!
-    endif
-!
-    do nb = 1,nbdim
-    do ndir = 1,2
-        if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then
-            select case(nbdim)
-            case(1)
-                i1 = child % childarray(1,1,2,nb,ndir)
-                i2 = child % childarray(1,2,2,nb,ndir)
-
-                call procname(parray1(i1:i2),                               &
-                              i1,i2, .FALSE.,coords(nb),ndir)
-            case(2)
-                i1 = child % childarray(1,1,2,nb,ndir)
-                i2 = child % childarray(1,2,2,nb,ndir)
-                j1 = child % childarray(2,1,2,nb,ndir)
-                j2 = child % childarray(2,2,2,nb,ndir)
-
-                call procname(parray2(i1:i2,j1:j2),                         &
-                              i1,i2,j1,j2, .FALSE.,coords(nb),ndir)
-            case(3)
-                i1 = child % childarray(1,1,2,nb,ndir)
-                i2 = child % childarray(1,2,2,nb,ndir)
-                j1 = child % childarray(2,1,2,nb,ndir)
-                j2 = child % childarray(2,2,2,nb,ndir)
-                k1 = child % childarray(3,1,2,nb,ndir)
-                k2 = child % childarray(3,2,2,nb,ndir)
-
-                call procname(parray3(i1:i2,j1:j2,k1:k2),                   &
-                              i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir)
-            case(4)
-                i1 = child % childarray(1,1,2,nb,ndir)
-                i2 = child % childarray(1,2,2,nb,ndir)
-                j1 = child % childarray(2,1,2,nb,ndir)
-                j2 = child % childarray(2,2,2,nb,ndir)
-                k1 = child % childarray(3,1,2,nb,ndir)
-                k2 = child % childarray(3,2,2,nb,ndir)
-                l1 = child % childarray(4,1,2,nb,ndir)
-                l2 = child % childarray(4,2,2,nb,ndir)
-
-                call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2),             &
-                              i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir)
-            case(5)
-                i1 = child % childarray(1,1,2,nb,ndir)
-                i2 = child % childarray(1,2,2,nb,ndir)
-                j1 = child % childarray(2,1,2,nb,ndir)
-                j2 = child % childarray(2,2,2,nb,ndir)
-                k1 = child % childarray(3,1,2,nb,ndir)
-                k2 = child % childarray(3,2,2,nb,ndir)
-                l1 = child % childarray(4,1,2,nb,ndir)
-                l2 = child % childarray(4,2,2,nb,ndir)
-                m1 = child % childarray(5,1,2,nb,ndir)
-                m2 = child % childarray(5,2,2,nb,ndir)
-
-                call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2),       &
-                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir)
-            case(6)
-                i1 = child % childarray(1,1,2,nb,ndir)
-                i2 = child % childarray(1,2,2,nb,ndir)
-                j1 = child % childarray(2,1,2,nb,ndir)
-                j2 = child % childarray(2,2,2,nb,ndir)
-                k1 = child % childarray(3,1,2,nb,ndir)
-                k2 = child % childarray(3,2,2,nb,ndir)
-                l1 = child % childarray(4,1,2,nb,ndir)
-                l2 = child % childarray(4,2,2,nb,ndir)
-                m1 = child % childarray(5,1,2,nb,ndir)
-                m2 = child % childarray(5,2,2,nb,ndir)
-                n1 = child % childarray(6,1,2,nb,ndir)
-                n2 = child % childarray(6,2,2,nb,ndir)
-
-                call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), &
-                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir)
-            end select
-        endif
-    enddo
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Correctnd
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine saveAfterInterp
-!
-!> saves the values of the grid variable on the fine grid after the space interpolation
-!---------------------------------------------------------------------------------------------------
-subroutine saveAfterInterp ( child_var, bounds, kindex, newsize, nbdim )
-!---------------------------------------------------------------------------------------------------
-    TYPE (Agrif_Variable),       INTENT(inout)  :: child_var !< The fine grid variable
-    INTEGER, DIMENSION(nbdim,2), INTENT(in)     :: bounds
-    INTEGER,                     INTENT(inout)  :: kindex    !< Index indicating where this safeguard
-                                                             !<     is done on the fine grid
-    INTEGER,                     INTENT(in)     :: newsize
-    INTEGER,                     INTENT(in)     :: nbdim
-!
-    INTEGER     :: ir,jr,kr,lr,mr,nr
-!
-!    Allocation of the array oldvalues2d
-!
-    if (newsize .LE. 0) return
-!
-    Call Agrif_Checksize(child_var,kindex+newsize)
-
-    if (child_var % interpIndex /= Agrif_Curgrid % parent % ngridstep ) then
-        child_var % oldvalues2d(1,kindex:kindex+newsize-1) = &
-        child_var % oldvalues2d(2,kindex:kindex+newsize-1)
-    endif
-
-    SELECT CASE (nbdim)
-    CASE (1)
-!CDIR ALTCODE
-        do ir = bounds(1,1), bounds(1,2)
-            child_var % oldvalues2d(2,kindex) = parray1(ir)
-            kindex = kindex + 1
-        enddo
-!
-    CASE (2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            child_var % oldvalues2d(2,kindex) = parray2(ir,jr)
-            kindex = kindex + 1
-        enddo
-        enddo
-!
-    CASE (3)
-        do kr = bounds(3,1),bounds(3,2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            child_var % oldvalues2d(2,kindex) = parray3(ir,jr,kr)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-!
-      CASE (4)
-        do lr = bounds(4,1),bounds(4,2)
-        do kr = bounds(3,1),bounds(3,2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            child_var % oldvalues2d(2,kindex) = parray4(ir,jr,kr,lr)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-        enddo
-!
-    CASE (5)
-        do mr = bounds(5,1),bounds(5,2)
-        do lr = bounds(4,1),bounds(4,2)
-        do kr = bounds(3,1),bounds(3,2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            child_var % oldvalues2d(2,kindex) = parray5(ir,jr,kr,lr,mr)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-!
-    CASE (6)
-        do nr = bounds(6,1),bounds(6,2)
-        do mr = bounds(5,1),bounds(5,2)
-        do lr = bounds(4,1),bounds(4,2)
-        do kr = bounds(3,1),bounds(3,2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            child_var % oldvalues2d(2,kindex) = parray6(ir,jr,kr,lr,mr,nr)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-    END SELECT
-!---------------------------------------------------------------------------------------------------
-end subroutine saveAfterInterp
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine timeInterpolation
-!
-!> subroutine for a linear time interpolation on the child grid
-!---------------------------------------------------------------------------------------------------
-subroutine timeInterpolation ( child_var, bounds, kindex, c1t, c2t, nbdim )
-!---------------------------------------------------------------------------------------------------
-    TYPE (Agrif_Variable)       :: child_var !< The fine grid variable
-    INTEGER, DIMENSION(nbdim,2) :: bounds
-    INTEGER                     :: kindex    !< Index indicating the values of the fine grid got
-                                             !<    before and after the space interpolation and
-                                             !<    used for the time interpolation
-    REAL                        :: c1t, c2t  !< Coefficients for the time interpolation (c2t=1-c1t)
-    INTEGER                     :: nbdim
-!
-    INTEGER :: ir,jr,kr,lr,mr,nr
-!
-    SELECT CASE (nbdim)
-    CASE (1)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            parray1(ir) = c2t*child_var % oldvalues2d(1,kindex) + &
-                                      c1t*child_var % oldvalues2d(2,kindex)
-            kindex = kindex + 1
-        enddo
-!
-    CASE (2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            parray2(ir,jr) = c2t*child_var % oldvalues2d(1,kindex) + &
-                                         c1t*child_var % oldvalues2d(2,kindex)
-            kindex = kindex + 1
-        enddo
-        enddo
-!
-    CASE (3)
-        do kr = bounds(3,1),bounds(3,2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            parray3(ir,jr,kr) = c2t*child_var % oldvalues2d(1,kindex) + &
-                                            c1t*child_var % oldvalues2d(2,kindex)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-!
-    CASE (4)
-        do lr = bounds(4,1),bounds(4,2)
-        do kr = bounds(3,1),bounds(3,2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            parray4(ir,jr,kr,lr) = c2t*child_var % oldvalues2d(1,kindex) + &
-                                               c1t*child_var % oldvalues2d(2,kindex)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-        enddo
-!
-    CASE (5)
-        do mr=bounds(5,1),bounds(5,2)
-        do lr=bounds(4,1),bounds(4,2)
-        do kr=bounds(3,1),bounds(3,2)
-        do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir=bounds(1,1),bounds(1,2)
-            parray5(ir,jr,kr,lr,mr) = c2t*child_var % oldvalues2d(1,kindex) + &
-                                                  c1t*child_var % oldvalues2d(2,kindex)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-!
-    CASE (6)
-        do nr=bounds(6,1),bounds(6,2)
-        do mr=bounds(5,1),bounds(5,2)
-        do lr=bounds(4,1),bounds(4,2)
-        do kr=bounds(3,1),bounds(3,2)
-        do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir=bounds(1,1),bounds(1,2)
-            parray6(ir,jr,kr,lr,mr,nr) = c2t*child_var % oldvalues2d(1,kindex) + &
-                                                     c1t*child_var % oldvalues2d(2,kindex)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-    END SELECT
-!---------------------------------------------------------------------------------------------------
-end subroutine timeInterpolation
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Checksize
-!
-!> subroutine used in the saveAfterInterp procedure to allocate the oldvalues2d array
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Checksize ( child_var, newsize )
-!---------------------------------------------------------------------------------------------------
-    TYPE (Agrif_Variable), INTENT(inout)  :: child_var !< The fine grid variable
-    INTEGER              , INTENT(in)     :: newsize   !< Size of the domains where the boundary
-                                                       !<    conditions are calculated
-!
-    REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
-!
-    if (.NOT. associated(child_var % oldvalues2d)) then
-!
-        allocate(child_var % oldvalues2d(2,newsize))
-        child_var % oldvalues2d = 0.
-!
-    else
-!
-        if (SIZE(child_var % oldvalues2d,2) < newsize) then
-!
-            allocate(tempoldvalues(2,SIZE(child_var % oldvalues2d,2)))
-            tempoldvalues = child_var % oldvalues2d
-            deallocate(child_var % oldvalues2d)
-            allocate(  child_var % oldvalues2d(2,newsize))
-            child_var % oldvalues2d = 0.
-            child_var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = tempoldvalues(:,:)
-            deallocate(tempoldvalues)
-!
-        endif
-!
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Checksize
-!===================================================================================================
-!
-end module Agrif_Boundary
-
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 10251)
@@ -0,0 +1,2448 @@
+!
+! $Id: modbcfunction.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module AGRIF_bcfunction
+C
+C 
+      Module  Agrif_bcfunction
+CCC   Description:
+CCC   
+C
+C     Modules used:
+C  
+      Use Agrif_Boundary
+      Use Agrif_Update
+      Use Agrif_fluxmod
+      Use Agrif_Save
+C             
+      IMPLICIT NONE
+C
+      interface Agrif_Bc_variable
+          module procedure Agrif_Bc_variable0d,
+     &                     Agrif_Bc_variable1d,
+     &                     Agrif_Bc_variable2d,
+     &                     Agrif_Bc_variable3d,
+     &                     Agrif_Bc_variable4d,
+     &                     Agrif_Bc_variable5d
+      end interface       
+C
+      interface Agrif_Set_Parent
+          module procedure Agrif_Set_Parent_int,
+     &                     Agrif_Set_Parent_real
+      end interface       
+C
+      interface Agrif_Interp_variable
+          module procedure Agrif_Interp_var0d,
+     &                     Agrif_Interp_var1d,
+     &                     Agrif_Interp_var2d,
+     &                     Agrif_Interp_var3d,
+     &                     Agrif_Interp_var4d,
+     &                     Agrif_Interp_var5d
+      end interface       
+C
+      interface Agrif_Init_variable
+          module procedure Agrif_Init_variable0d,
+     &                     Agrif_Init_variable1d,
+     &                     Agrif_Init_variable2d,
+     &                     Agrif_Init_variable3d,
+     &                     Agrif_Init_variable4d
+      end interface       
+C
+      interface Agrif_update_variable
+          module procedure Agrif_update_var0d,
+     &                     Agrif_update_var1d,
+     &                     Agrif_update_var2d,
+     &                     Agrif_update_var3d,
+     &                     Agrif_update_var4d,
+     &                     Agrif_update_var5d
+      end interface       
+      
+      interface Agrif_Save_Forrestore
+         module procedure Agrif_Save_Forrestore0d,    
+     &                    Agrif_Save_Forrestore2d,    
+     &                    Agrif_Save_Forrestore3d,    
+     &                    Agrif_Save_Forrestore4d
+      end interface
+C
+      Contains 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_type
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_type(tabvarsindic,posvar,point)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: point
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: dimensio ! DIMENSION of the variable
+      INTEGER :: i
+C
+C
+C     Begin 
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
+C
+      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
+     &                                 %var % posvar)) then
+      Allocate( 
+     & Agrif_Mygrid % tabvars(tabvarsindic)%var % posvar(dimensio))
+      endif 
+            
+      do i = 1 , dimensio
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % posvar(i)
+     &                       = posvar(i)
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % point(i) 
+     &                       = point(i)
+      enddo
+C
+C
+      End Subroutine Agrif_Set_type
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_parent_int
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_parent_int(tabvarsindic,value)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: Value
+C
+C     Begin 
+C
+      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
+     &         var % iarray0 = value
+C
+C
+      End Subroutine Agrif_Set_parent_int
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_parent_real
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_parent_real(tabvarsindic,value)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      REAL :: Value
+C
+C     Begin 
+C
+      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
+     &          var % array0 = value
+C
+C
+      End Subroutine Agrif_Set_parent_real
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_raf
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_raf(tabvarsindic,tabraf)
+C
+CCC   Description:
+CCC   Attention tabraf est de taille trois si on ne raffine pas suivant z la
+CCC             troisieme entree du tableau tabraf est 'N'
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      CHARACTER(*) ,DIMENSION(:) :: tabraf
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: dimensio ! DIMENSION of the variable
+      INTEGER :: i
+C
+C
+C     Begin 
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
+C        
+      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
+     &                                 %var % interptab)) then 
+      Allocate(
+     & Agrif_Mygrid % tabvars(tabvarsindic)%var% interptab(dimensio))
+      endif
+
+      do i = 1 , dimensio
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % interptab(i) 
+     &                 = TRIM(tabraf(i))
+      enddo
+C
+      End Subroutine Agrif_Set_raf
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_bc
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_bc(tabvarsindic,point,
+     &          Interpolationshouldbemade)
+C
+CCC   Description:
+CCC
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, DIMENSION(2) :: point
+      LOGICAL, OPTIONAL :: Interpolationshouldbemade
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      endif  
+      
+      if (Agrif_Curgrid % fixedrank .NE. 0) then  
+       IF (.Not.Associated(tabvars%var% interpIndex)) THEN
+        Allocate(tabvars%var % interpIndex)
+          tabvars%var % interpIndex = -1
+
+        Allocate(tabvars%var % oldvalues2D(2,1))
+          tabvars%var % oldvalues2D = 0. 
+       ENDIF      
+       if ( PRESENT(Interpolationshouldbemade) ) then
+         tabvars%var %
+     &     Interpolationshouldbemade = Interpolationshouldbemade
+       endif
+
+      endif
+C
+      tabvars%var % bcinf = point(1)
+      tabvars%var % bcsup = point(2)
+C
+      End Subroutine Agrif_Set_bc
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_interp
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_interp(tabvarsindic,interp,interp1,interp2,
+     &                interp3)
+C
+CCC   Description:
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Mygrid % tabvars(indic)
+      endif      
+C
+C     Begin 
+C
+      tabvars % var % Typeinterp = 
+     &    Agrif_Constant
+      IF (present(interp)) THEN
+      tabvars % var % Typeinterp = 
+     &           interp
+      ENDIF
+      IF (present(interp1)) THEN
+      tabvars % var % Typeinterp(1) = 
+     &           interp1
+      ENDIF
+      IF (present(interp2)) THEN
+      tabvars % var % Typeinterp(2) = 
+     &           interp2
+      ENDIF
+      IF (present(interp3)) THEN
+      tabvars % var % Typeinterp(3) = 
+     &           interp3
+      ENDIF
+C
+      End Subroutine Agrif_Set_interp
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_bcinterp
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_bcinterp(tabvarsindic,interp,interp1,
+     &      interp2,interp3,interp11,interp12,interp21,interp22)
+C
+CCC   Description:
+
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
+      INTEGER, OPTIONAL      :: interp11,interp12,interp21,interp22
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Mygrid % tabvars(indic)
+      endif 
+C
+      tabvars% var % bctypeinterp = 
+     &           Agrif_Constant   
+      IF (present(interp)) THEN
+      tabvars% var % bctypeinterp = 
+     &           interp
+      ENDIF       
+      IF (present(interp1)) THEN
+      tabvars% var % bctypeinterp(1:2,1) = 
+     &           interp1
+      ENDIF       
+      IF (present(interp11)) THEN
+      tabvars% var % bctypeinterp(1,1) = 
+     &           interp11
+      ENDIF
+      IF (present(interp12)) THEN
+      tabvars% var % bctypeinterp(1,2) = 
+     &           interp12
+      ENDIF          
+      IF (present(interp2)) THEN
+      tabvars% var % bctypeinterp(1:2,2) = 
+     &           interp2
+      ENDIF
+      IF (present(interp21)) THEN
+      tabvars% var % bctypeinterp(2,1) = 
+     &           interp21
+      ENDIF      
+      IF (present(interp22)) THEN
+      tabvars% var % bctypeinterp(2,2) = 
+     &           interp22
+      ENDIF            
+      IF (present(interp3)) THEN
+      tabvars% var % bctypeinterp(1:2,3) =
+     &           interp3
+      ENDIF
+C
+      End Subroutine Agrif_Set_bcinterp
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_Update
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_Update(tabvarsindic,point)
+C
+CCC   Description:
+CCC
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, DIMENSION(2) :: point
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+C
+C
+C     Begin 
+C
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = point(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = point(2)
+C
+      End Subroutine Agrif_Set_Update
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_UpdateType
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_UpdateType(tabvarsindic,
+     &                                  update,update1,update2,
+     &                                  update3,update4,update5)
+C
+CCC   Description:
+
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL           :: update, update1,
+     &       update2, update3,update4,update5
+C
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer :: roottabvars      
+C
+C
+C     Begin 
+
+      indic = tabvarsindic
+
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+C
+      roottabvars% var % typeupdate = 
+     &                   Agrif_Update_Copy
+      
+      IF (present(update)) THEN
+        roottabvars% var % typeupdate = 
+     &           update
+      ENDIF
+      IF (present(update1)) THEN
+        roottabvars% var % typeupdate(1) = 
+     &           update1
+      ENDIF  
+      IF (present(update2)) THEN
+        roottabvars% var % typeupdate(2) = 
+     &           update2
+      ENDIF  
+      IF (present(update3)) THEN
+        roottabvars% var % typeupdate(3) = 
+     &           update3
+      ENDIF 
+      IF (present(update4)) THEN
+        roottabvars% var % typeupdate(4) = 
+     &           update4
+      ENDIF       
+      IF (present(update5)) THEN
+        roottabvars% var % typeupdate(5) = 
+     &           update5
+      ENDIF                  
+C
+      End Subroutine Agrif_Set_UpdateType           
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_restore
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_restore(tabvarsindic)
+C
+CCC   Description:
+CCC   
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+C
+C     Begin 
+C
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif  
+C
+      Agrif_Mygrid%tabvars(indic)%var % restaure = .TRUE.
+C
+      End Subroutine Agrif_Set_restore
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable0d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic,
+     &        procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(tabvarsindic0,indic,procname)
+      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(tabvarsindic0,indic)
+      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.)
+      endif
+
+      End Subroutine Agrif_Init_variable0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable1d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable1d(q,tabvarsindic,procname)
+
+      REAL, DIMENSION(:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+      End Subroutine Agrif_Init_variable1d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable2d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable2d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      integer :: indic
+
+C
+      if (Agrif_Root()) Return
+C
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+
+      End Subroutine Agrif_Init_variable2d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable3d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable3d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+C
+      End Subroutine Agrif_Init_variable3d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable4d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable4d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+C
+      End Subroutine Agrif_Init_variable4d      
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable0d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable0d(tabvarsindic0,tabvarsindic,
+     &                               calledweight,procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+C        
+      External :: procname
+      Optional ::  procname
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+C
+      INTEGER :: dimensio      
+
+      if (Agrif_Root()) Return
+C
+      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim    
+C
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+C      
+C
+
+      
+      if ( dimensio .EQ. 1 ) Call Agrif_Interp_Bc_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array1,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,
+     & pweight)
+C
+      if ( dimensio .EQ. 2 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)
+      ELSE
+          
+      Call Agrif_Interp_Bc_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 3 ) then
+      IF (present(procname)) THEN
+
+      Call Agrif_Interp_Bc_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 4 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 5 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 6 ) Call Agrif_Interp_Bc_6D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array6,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,
+     & pweight)
+C
+C
+      End Subroutine Agrif_Bc_variable0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable1d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif         
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_1D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_1D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable1d 
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable2d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_2D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_2D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable2d
+            
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable3d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable3d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_3D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_3D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable3d
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable4d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable4d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+      
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_4D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_4D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable4d
+            
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable5d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_5d(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_5d(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable5d
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var0D
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic,procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic, indic  ! indice of the variable in tabvars
+      INTEGER :: dimensio  ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C      
+      if (Agrif_Root()) Return
+C     
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+C     
+      dimensio = Agrif_Mygrid % tabvars(indic) % var % nbdim 
+C
+      if ( dimensio .EQ. 1 ) then
+       if (present(procname)) then
+       Call Agrif_Interp_1D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+       else
+       Call Agrif_Interp_1D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+       endif
+       endif
+C
+      if ( dimensio .EQ. 2 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_2D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_2D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 3 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_3D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_3D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 4 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_4D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_4D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 5 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_5D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_5D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+       endif
+       endif
+C
+      if ( dimensio .EQ. 6 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_6D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_6D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      Return
+      End Subroutine Agrif_Interp_var0d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var1d(q,tabvarsindic,procname)
+
+      REAL, DIMENSION(:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      if (present(procname)) then
+      Call Agrif_Interp_1D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_1D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif
+      Return
+      End Subroutine Agrif_Interp_var1d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var2d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+       if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+            
+       if (present(procname)) then
+       Call Agrif_Interp_2D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+       else
+       Call Agrif_Interp_2D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif 
+      Return
+      End Subroutine Agrif_Interp_var2d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var3d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+      if (present(procname)) then
+      Call Agrif_Interp_3D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_3D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif   
+      Return
+      End Subroutine Agrif_Interp_var3d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var4d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars  
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      if (present(procname)) then
+      Call Agrif_Interp_4D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_4D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif      
+
+      Return
+      End Subroutine Agrif_Interp_var4d     
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var5d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      if (present(procname)) then
+      Call Agrif_Interp_5D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_5D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif
+      Return
+      End Subroutine Agrif_Interp_var5d       
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var0d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic,
+     &                              locupdate,locupdate1,
+     &                  locupdate2,procname)
+
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname      
+      INTEGER :: dimensio
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2            
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
+C      
+      if (Agrif_Root()) Return
+      
+C     
+      IF (present(locupdate)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio)
+     &      = locupdate(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
+     &      = locupdate(2)
+      ELSE
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio) 
+     &      = -99
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
+     &      = locupdate1(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
+     &      = locupdate2(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF             
+ 
+      if ( dimensio .EQ. 1 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 2 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 3 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 4 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 5 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+
+      Return
+      End Subroutine Agrif_update_var0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:) :: q
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname      
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars   
+C      
+      if (Agrif_Root()) Return
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:1) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:1) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:1) 
+     &      = -99
+      tabvars%var % updatesup(1:1) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF       
+ 
+      IF (present(procname)) THEN
+      Call Agrif_Update_1D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_1D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var1d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN
+      
+C 
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:2) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:2) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:2) 
+     &      = -99
+      tabvars%var % updatesup(1:2) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+ 
+      IF (present(procname)) THEN
+      Call Agrif_Update_2D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_2D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var2d
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN 
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:3) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:3) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:3) 
+     &      = -99
+      tabvars%var % updatesup(1:3) 
+     &      = -99
+      ENDIF      
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_3D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_3D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var3d
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)     
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+C      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:4) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:4) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:4) 
+     &      = -99
+      tabvars%var % updatesup(1:4) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_4D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_4D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var4d  
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C
+      IF (Agrif_Root()) RETURN
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+       
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:5) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:5) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:5) 
+     &      = -99
+      tabvars%var % updatesup(1:5) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_5D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_5D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var5d  
+          
+      Subroutine Agrif_Declare_Flux(fluxname,profilename) 
+      character*(*) :: fluxname, profilename
+      Type(Agrif_Flux), pointer :: newflux
+      Type(Agrif_Profile), pointer  :: parcours
+      logical :: foundprofile
+      integer :: i,j,n
+            
+      foundprofile = .FALSE.
+      parcours => Agrif_Myprofiles
+      
+      Do While (Associated(parcours))
+         IF (parcours % profilename == profilename) THEN
+           foundprofile = .TRUE.
+           EXIT
+         ENDIF
+         parcours => parcours%nextprofile
+      End Do      
+      
+      IF (.NOT.foundprofile) THEN
+      write(*,*) 'The profile '''
+     &           //TRIM(profilename)//''' has not been declared'  
+      stop    
+      ENDIF
+      
+      Allocate(Newflux)
+      
+      Newflux % fluxname = fluxname
+      
+      Newflux % profile => parcours
+      
+      Newflux % nextflux => Agrif_Curgrid % fluxes
+      
+      Agrif_Curgrid % fluxes => Newflux
+      
+      End Subroutine Agrif_Declare_Flux  
+       
+      Subroutine Agrif_Save_Flux(fluxname, fluxtab)
+      character*(*) :: fluxname
+      REAL, DIMENSION(:,:) :: fluxtab
+      
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Type(Agrif_pgrid), pointer :: parcours_child
+      
+      Type(Agrif_grid), Pointer :: currentgrid,oldcurgrid
+      
+      IF (.Not.Agrif_Root()) THEN
+      Flux => Agrif_Search_Flux(fluxname)
+
+      IF (.NOT.Flux%fluxallocated) THEN
+        CALL Agrif_AllocateFlux(Flux,fluxtab)
+      ENDIF
+      
+      Call Agrif_Save_Fluxtab(Flux,fluxtab)
+      
+      ENDIF
+      
+      oldcurgrid=> Agrif_Curgrid
+      
+      parcours_child => Agrif_Curgrid%child_grids
+      
+      Do While (Associated(parcours_child))
+        currentgrid => parcours_child%gr
+        Agrif_Curgrid => parcours_child%gr
+        Flux => Agrif_Search_Flux(fluxname)
+        IF (.NOT.Flux%fluxallocated) THEN
+          CALL Agrif_AllocateFlux(Flux,fluxtab)
+        ENDIF        
+        Call Agrif_Save_Fluxtab_child(Flux,fluxtab)
+        parcours_child=> parcours_child%next
+      End Do
+      
+      Agrif_Curgrid=>oldcurgrid
+      
+      End Subroutine Agrif_Save_Flux
+
+      Subroutine Agrif_Cancel_Flux(fluxname)
+      character*(*) :: fluxname
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Flux => Agrif_Search_Flux(fluxname)
+
+      IF (Flux%FluxAllocated) Call Agrif_Cancel_Fluxarray(Flux)
+      
+      End Subroutine Agrif_Cancel_Flux
+ 
+      Subroutine Agrif_Flux_Correction(fluxname, procname)
+      character*(*) :: fluxname
+      external :: procname
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Flux => Agrif_Search_Flux(fluxname)
+      
+      Call Agrif_FluxCorrect(Flux, procname)
+
+      
+      End Subroutine Agrif_Flux_Correction
+
+
+      
+      Subroutine Agrif_Declare_Profile_flux(profilename,posvar,
+     &    firstpoint,raf)
+      character*(*) :: profilename
+      Type(Agrif_Profile), Pointer :: newprofile
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: firstpoint
+      CHARACTER(*) ,DIMENSION(:) :: raf      
+      INTEGER :: dimensio
+            
+      dimensio = SIZE(posvar)
+C
+C    
+      Allocate(newprofile)
+      Allocate(newprofile%posvar(dimensio))
+      Allocate(newprofile%interptab(dimensio))
+      newprofile%profilename = profilename
+      newprofile%interptab = raf
+      newprofile%nbdim = dimensio
+      newprofile%posvar = posvar
+      newprofile%point(1:dimensio) = firstpoint
+      
+      newprofile % nextprofile => Agrif_myprofiles
+      
+      Agrif_myprofiles => newprofile
+      
+      End Subroutine Agrif_Declare_Profile_flux
+
+      Subroutine Agrif_Save_ForRestore0D(tabvarsindic0,tabvarsindic)
+      integer :: tabvarsindic0, tabvarsindic
+      integer :: dimensio
+              
+      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic0) % var % nbdim
+      
+      select case(dimensio)
+      case(2)
+          call Agrif_Save_ForRestore2D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2,
+     &      tabvarsindic)
+      case(3)
+          call Agrif_Save_ForRestore3D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3,
+     &      tabvarsindic)
+      case(4)
+          call Agrif_Save_ForRestore4D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4,
+     &      tabvarsindic)     
+      end select
+
+      Return
+      End Subroutine Agrif_Save_ForRestore0D 
+      
+    
+      
+      Subroutine Agrif_Save_ForRestore2D(q,tabvarsindic)
+      real,dimension(:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+      if (.not.allocated(tabvars%var%array2)) then      
+      allocate(tabvars%var%array2(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2)))
+      endif
+      tabvars%var%array2 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore2D  
+      
+      Subroutine Agrif_Save_ForRestore3D(q,tabvarsindic)
+      real,dimension(:,:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+
+      if (.not.allocated(tabvars%var%array3)) then
+      allocate(tabvars%var%array3(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2),
+     &                            tabvars%var%lb(3):tabvars%var%ub(3)))
+      endif
+      tabvars%var%array3 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore3D
+      
+      Subroutine Agrif_Save_ForRestore4D(q,tabvarsindic)
+      real,dimension(:,:,:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+      if (.not.allocated(tabvars%var%array4)) then         
+      allocate(tabvars%var%array4(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2),
+     &                            tabvars%var%lb(3):tabvars%var%ub(3),
+     &                            tabvars%var%lb(4):tabvars%var%ub(4)))
+      endif
+      tabvars%var%array4 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore4D                   
+C
+      End module Agrif_bcfunction
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 10250)
+++ 	(revision )
@@ -1,680 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-!
-!> Module Agrif_BcFunction.
-!
-module Agrif_BcFunction
-!
-!     Modules used:
-!
-    use Agrif_Boundary
-    use Agrif_Update
-    use Agrif_Save
-!
-    implicit none
-!
-    interface Agrif_Set_Parent
-        module procedure Agrif_Set_Parent_int,      &
-                         Agrif_Set_Parent_real4,    &
-                         Agrif_Set_Parent_real8
-    end interface
-!
-    interface Agrif_Save_Forrestore
-        module procedure Agrif_Save_Forrestore0d,   &
-                         Agrif_Save_Forrestore2d,   &
-                         Agrif_Save_Forrestore3d,   &
-                         Agrif_Save_Forrestore4d
-    end interface
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_Set_parent_int
-!
-!> To set the TYPE of the variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_parent_int(tabvarsindic,value)
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
-    integer, intent(in)     :: value        !< input value
-!
-    Agrif_Curgrid % parent % tabvars_i(tabvarsindic) % iarray0 = value
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_parent_int
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_parent_real4
-!---------------------------------------------------------------------------------------------------
-!> To set the TYPE of the variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_parent_real4 ( tabvarsindic, value )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
-    real(kind=4),intent(in) :: value        !< input value
-!
-    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % array0 = value
-    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % sarray0 = value
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_parent_real4
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_parent_real8
-!---------------------------------------------------------------------------------------------------
-!> To set the TYPE of the variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_parent_real8 ( tabvarsindic, value )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
-    real(kind=8),intent(in) :: value        !< input value
-!
-    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % darray0 = value
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_parent_real8
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_bc
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_bc ( tabvarsindic, bcinfsup, Interpolationshouldbemade )
-!---------------------------------------------------------------------------------------------------
-    integer,               intent(in)   :: tabvarsindic !< indice of the variable in tabvars
-    integer, dimension(2), intent(in)   :: bcinfsup     !< bcinfsup
-    logical, optional,     intent(in)   :: Interpolationshouldbemade !< interpolation should be made
-!
-    integer                         :: indic ! indice of the variable in tabvars
-    type(Agrif_Variable),  pointer  :: var
-!
-    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
-!
-    if (indic <= 0) then
-        var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-    else
-        print*,"Agrif_Set_bc : warning indic >= 0 !!!"
-        var => Agrif_Curgrid % tabvars(indic)
-    endif
-
-    if (.not.associated(var)) return ! Grand mother grid case
-!
-    if ( Agrif_Curgrid % fixedrank /= 0 ) then
-        if ( .not.associated(var % oldvalues2D) ) then
-            allocate(var % oldvalues2D(2,1))
-            var % interpIndex = -1
-            var % oldvalues2D = 0.
-        endif
-        if ( present(Interpolationshouldbemade) ) then
-            var % Interpolationshouldbemade = Interpolationshouldbemade
-        endif
-    endif
-!
-    var % bcinf = bcinfsup(1)
-    var % bcsup = bcinfsup(2)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_bc
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_interp
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_interp ( tabvarsindic, interp, interp1, interp2, interp3 , interp4)
-!---------------------------------------------------------------------------------------------------
-    integer,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
-    integer, optional, intent(in)   :: interp, interp1, interp2, interp3, interp4
-!
-    integer                         :: indic ! indice of the variable in tabvars
-    type(Agrif_Variable), pointer   :: var
-!
-    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
-!
-    if (indic <= 0) then
-        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        print*,"Agrif_Set_interp : warning indic >= 0 !!!"
-        var => Agrif_Mygrid % tabvars(indic)
-    endif
-!
-    var % type_interp = Agrif_Constant
-!
-    if (present(interp))    var % type_interp    = interp
-    if (present(interp1))   var % type_interp(1) = interp1
-    if (present(interp2))   var % type_interp(2) = interp2
-    if (present(interp3))   var % type_interp(3) = interp3
-    if (present(interp4))   var % type_interp(4) = interp4
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_interp
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_bcinterp
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_bcinterp ( tabvarsindic, interp,   interp1,  interp2,  interp3, interp4, &
-                                              interp11, interp12, interp21, interp22 )
-!---------------------------------------------------------------------------------------------------
-    INTEGER,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
-    INTEGER, OPTIONAL, intent(in)   :: interp,   interp1,  interp2,  interp3, interp4
-    INTEGER, OPTIONAL, intent(in)   :: interp11, interp12, interp21, interp22
-!
-    INTEGER                         :: indic ! indice of the variable in tabvars
-    TYPE(Agrif_Variable), pointer   :: var
-!
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if (indic <= 0) then
-        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        print*,"Agrif_Set_bcinterp : warning indic >= 0 !!!"
-        var => Agrif_Mygrid % tabvars(indic)
-    endif
-!
-    var % type_interp_bc = Agrif_Constant
-!
-    if (present(interp))    var % type_interp_bc      = interp
-    if (present(interp1))   var % type_interp_bc(:,1) = interp1
-    if (present(interp11))  var % type_interp_bc(1,1) = interp11
-    if (present(interp12))  var % type_interp_bc(1,2) = interp12
-    if (present(interp2))   var % type_interp_bc(:,2) = interp2
-    if (present(interp21))  var % type_interp_bc(2,1) = interp21
-    if (present(interp22))  var % type_interp_bc(2,2) = interp22
-    if (present(interp3))   var % type_interp_bc(:,3) = interp3
-    if (present(interp4))   var % type_interp_bc(:,4) = interp4
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_bcinterp
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_UpdateType
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_UpdateType ( tabvarsindic, update,  update1, update2, &
-                                                update3, update4, update5 )
-!---------------------------------------------------------------------------------------------------
-    INTEGER,           intent(in) :: tabvarsindic     !< indice of the variable in tabvars
-    INTEGER, OPTIONAL, intent(in) :: update, update1, update2, update3, update4, update5
-!
-    INTEGER                         :: indic ! indice of the variable in tabvars
-    type(Agrif_Variable),  pointer  :: root_var
-!
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if (indic <= 0) then
-        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        print*,"Agrif_Set_UpdateType : warning indic >= 0 !!!"
-        root_var => Agrif_Mygrid % tabvars(indic)
-    endif
-!
-    root_var % type_update = Agrif_Update_Copy
-    if (present(update))    root_var % type_update    = update
-    if (present(update1))   root_var % type_update(1) = update1
-    if (present(update2))   root_var % type_update(2) = update2
-    if (present(update3))   root_var % type_update(3) = update3
-    if (present(update4))   root_var % type_update(4) = update4
-    if (present(update5))   root_var % type_update(5) = update5
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_UpdateType
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_restore
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_restore ( tabvarsindic )
-!---------------------------------------------------------------------------------------------------
-    INTEGER, intent(in) :: tabvarsindic     !< indice of the variable in tabvars
-!
-    INTEGER :: indic  !  indice of the variable in tabvars
-!
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    Agrif_Mygrid%tabvars(indic) % restore = .TRUE.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_restore
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Init_variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Init_variable ( tabvarsindic, procname )
-!---------------------------------------------------------------------------------------------------
-    INTEGER, intent(in)  :: tabvarsindic     !< indice of the variable in tabvars
-    procedure()          :: procname         !< Data recovery procedure
-!
-    if ( Agrif_Curgrid%level <= 0 ) return
-!
-    call Agrif_Interp_variable(tabvarsindic, procname)
-    call Agrif_Bc_variable(tabvarsindic, procname, 1.)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Init_variable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Bc_variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Bc_variable ( tabvarsindic, procname, calledweight )
-!---------------------------------------------------------------------------------------------------
-    integer,        intent(in) :: tabvarsindic     !< indice of the variable in tabvars
-    procedure()                :: procname
-    real, optional, intent(in) :: calledweight
-!
-    real    :: weight
-    logical :: pweight
-    integer :: indic
-    integer :: nbdim
-    type(Agrif_Variable), pointer :: root_var
-    type(Agrif_Variable), pointer :: parent_var
-    type(Agrif_Variable), pointer :: child_var
-    type(Agrif_Variable), pointer :: child_tmp      ! Temporary variable on the child grid
-!
-    if ( Agrif_Curgrid%level <= 0 ) return
-!
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if ( present(calledweight) ) then
-        weight  = calledweight
-        pweight = .true.
-    else
-        weight  = 0.
-        pweight = .false.
-    endif
-!
-    if (indic <= 0) then
-        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-        parent_var => child_var % parent_var
-        root_var   => child_var % root_var
-    else
-        print*,"Agrif_Bc_variable : warning indic >= 0 !!!"
-        child_var  => Agrif_Curgrid % tabvars(indic)
-        parent_var => Agrif_Curgrid % parent % tabvars(indic)
-        root_var   => Agrif_Mygrid % tabvars(indic)
-    endif
-!
-    nbdim = root_var % nbdim
-!
-    select case( nbdim )
-    case(1)
-        allocate(parray1(child_var%lb(1):child_var%ub(1)))
-    case(2)
-        allocate(parray2(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2) ))
-    case(3)
-        allocate(parray3(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2), &
-                         child_var%lb(3):child_var%ub(3) ))
-    case(4)
-        allocate(parray4(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2), &
-                         child_var%lb(3):child_var%ub(3), &
-                         child_var%lb(4):child_var%ub(4) ))
-    case(5)
-        allocate(parray5(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2), &
-                         child_var%lb(3):child_var%ub(3), &
-                         child_var%lb(4):child_var%ub(4), &
-                         child_var%lb(5):child_var%ub(5) ))
-    case(6)
-        allocate(parray6(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2), &
-                         child_var%lb(3):child_var%ub(3), &
-                         child_var%lb(4):child_var%ub(4), &
-                         child_var%lb(5):child_var%ub(5), &
-                         child_var%lb(6):child_var%ub(6) ))
-    end select
-!
-!   Create temporary child variable
-    allocate(child_tmp)
-!
-    child_tmp % root_var => root_var
-    child_tmp % oldvalues2D => child_var % oldvalues2D
-!
-!   Index indicating if a space interpolation is necessary
-    child_tmp % interpIndex =  child_var % interpIndex
-    child_tmp % list_interp => child_var % list_interp
-    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
-!
-    child_tmp % point = child_var % point
-    child_tmp % lb = child_var % lb
-    child_tmp % ub = child_var % ub
-!
-    child_tmp % bcinf = child_var % bcinf
-    child_tmp % bcsup = child_var % bcsup
-!
-    child_tmp % childarray = child_var % childarray
-    child_tmp % memberin   = child_var % memberin
-!
-    call Agrif_CorrectVariable(parent_var, child_tmp, pweight, weight, procname)
-!
-    child_var % childarray = child_tmp % childarray
-    child_var % memberin   = child_tmp % memberin
-!
-    child_var % oldvalues2D => child_tmp % oldvalues2D
-    child_var % list_interp => child_tmp % list_interp
-!
-    child_var % interpIndex = child_tmp % interpIndex
-!
-    deallocate(child_tmp)
-!
-    select case( nbdim )
-        case(1); deallocate(parray1)
-        case(2); deallocate(parray2)
-        case(3); deallocate(parray3)
-        case(4); deallocate(parray4)
-        case(5); deallocate(parray5)
-        case(6); deallocate(parray6)
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Bc_variable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Interp_variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Interp_variable ( tabvarsindic, procname )
-!---------------------------------------------------------------------------------------------------
-    integer,     intent(in)     :: tabvarsindic     !< indice of the variable in tabvars
-    procedure()                 :: procname         !< Data recovery procedure
-!
-    integer :: nbdim
-    integer :: indic  ! indice of the variable in tabvars
-    logical :: torestore
-    type(Agrif_Variable), pointer   :: root_var
-    type(Agrif_Variable), pointer   :: parent_var       ! Variable on the parent grid
-    type(Agrif_Variable), pointer   :: child_var        ! Variable on the parent grid
-    type(Agrif_Variable), pointer   :: child_tmp        ! Temporary variable on the child grid
-!
-    if ( Agrif_Curgrid%level <= 0 ) return
-!
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if (indic <= 0) then
-        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-        parent_var => child_var % parent_var
-        root_var   => child_var % root_var
-    else
-        print*,"Agrif_Interp_variable : warning indic >= 0 !!!"
-        child_var  => Agrif_Curgrid % tabvars(indic)
-        parent_var => Agrif_Curgrid % parent % tabvars(indic)
-        root_var   => Agrif_Mygrid % tabvars(indic)
-    endif
-!
-    nbdim     = root_var % nbdim
-    torestore = root_var % restore
-!
-    allocate(child_tmp)
-!
-    child_tmp % root_var => root_var
-    child_tmp % nbdim = root_var % nbdim
-    child_tmp % point = child_var % point
-    child_tmp % lb = child_var % lb
-    child_tmp % ub = child_var % ub
-    child_tmp % interpIndex =  child_var % interpIndex
-    child_tmp % list_interp => child_var % list_interp
-    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
-!
-    if ( torestore ) then
-        select case( nbdim )
-        case(1)
-            parray1 = child_var % array1
-            child_tmp % restore1D => child_var % restore1D
-        case(2)
-            parray2 = child_var % array2
-            child_tmp % restore2D => child_var % restore2D
-        case(3)
-            parray3 = child_var % array3
-            child_tmp % restore3D => child_var % restore3D
-        case(4)
-            parray4 = child_var % array4
-            child_tmp % restore4D => child_var % restore4D
-        case(5)
-            parray5 = child_var % array5
-            child_tmp % restore5D => child_var % restore5D
-        case(6)
-            parray6 = child_var % array6
-            child_tmp % restore6D => child_var % restore6D
-        end select
-    endif
-!
-    call Agrif_InterpVariable(parent_var, child_tmp, torestore, procname)
-!
-    child_var % list_interp => child_tmp % list_interp
-!
-    deallocate(child_tmp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Interp_variable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Update_Variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_Variable ( tabvarsindic, procname, &
-                                   locupdate, locupdate1, locupdate2, locupdate3, locupdate4 )
-!---------------------------------------------------------------------------------------------------
-    integer,               intent(in)           :: tabvarsindic     !< Indice of the variable in tabvars
-    procedure()                                 :: procname         !< Data recovery procedure
-    integer, dimension(2), intent(in), optional :: locupdate
-    integer, dimension(2), intent(in), optional :: locupdate1
-    integer, dimension(2), intent(in), optional :: locupdate2
-    integer, dimension(2), intent(in), optional :: locupdate3
-    integer, dimension(2), intent(in), optional :: locupdate4
-!---------------------------------------------------------------------------------------------------
-    integer :: indic
-    integer :: nbdim
-    integer, dimension(6)           :: updateinf    ! First positions where interpolations are calculated
-    integer, dimension(6)           :: updatesup    ! Last  positions where interpolations are calculated
-    type(Agrif_Variable), pointer   :: root_var
-    type(Agrif_Variable), pointer   :: parent_var
-    type(Agrif_Variable), pointer   :: child_var
-!
-    if ( Agrif_Root() .AND. (.not.agrif_coarse) ) return
-    if (agrif_curgrid%grand_mother_grid) return
-!
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if (indic <= 0) then
-        child_var  => Agrif_Search_Variable(Agrif_Curgrid, -indic)
-        parent_var => child_var % parent_var
-
-        if (.not.associated(parent_var)) then
-          ! can occur during the first update of Agrif_Coarsegrid (if any)
-          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, -indic)
-          child_var % parent_var => parent_var
-        endif
-
-        root_var   => child_var % root_var
-    else
-        print*,"Agrif_Update_Variable : warning indic >= 0 !!!"
-        root_var   => Agrif_Mygrid  % tabvars(indic)
-        child_var  => Agrif_Curgrid % tabvars(indic)
-        parent_var => Agrif_Curgrid % parent % tabvars(indic)
-    endif
-!
-    nbdim = root_var % nbdim
-!
-    updateinf = -99
-    updatesup = -99
-!
-    if ( present(locupdate) ) then
-        updateinf(1:nbdim) = locupdate(1)
-        updatesup(1:nbdim) = locupdate(2)
-    endif
-!
-    if ( present(locupdate1) ) then
-        updateinf(1) = locupdate1(1)
-        updatesup(1) = locupdate1(2)
-    endif
-!
-    if ( present(locupdate2) ) then
-        updateinf(2) = locupdate2(1)
-        updatesup(2) = locupdate2(2)
-    endif
-
-    if ( present(locupdate3) ) then
-        updateinf(3) = locupdate3(1)
-        updatesup(3) = locupdate3(2)
-    endif
-
-    if ( present(locupdate4) ) then
-        updateinf(4) = locupdate4(1)
-        updatesup(4) = locupdate4(2)
-    endif
-!
-    call Agrif_UpdateVariable( parent_var, child_var, updateinf, updatesup, procname )
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_Variable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Save_ForRestore0D
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: tabvarsindic0, tabvarsindic
-!
-    type(Agrif_Variable), pointer   :: root_var, save_var
-    integer :: nbdim
-!
-    root_var => Agrif_Mygrid % tabvars(tabvarsindic0)
-    save_var => Agrif_Curgrid % tabvars(tabvarsindic0)
-    nbdim =  root_var % nbdim
-!
-    select case(nbdim)
-        case(2); call Agrif_Save_ForRestore2D(save_var % array2, tabvarsindic)
-        case(3); call Agrif_Save_ForRestore3D(save_var % array3, tabvarsindic)
-        case(4); call Agrif_Save_ForRestore4D(save_var % array4, tabvarsindic)
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Save_ForRestore0D
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Save_ForRestore2D
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic )
-!---------------------------------------------------------------------------------------------------
-    real, dimension(:,:), intent(in)        :: q
-    integer,              intent(in)        :: tabvarsindic
-!
-    type(Agrif_Variable),  pointer  :: root_var, save_var
-    integer                         :: indic
-!
-    indic = tabvarsindic
-    if (tabvarsindic >= 0) then
-        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
-            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-        endif
-    endif
-!
-    if (indic <= 0) then
-        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        save_var => Agrif_Curgrid % tabvars(indic)
-        root_var => Agrif_Mygrid % tabvars(indic)
-    endif
-!
-    if ( .not.allocated(save_var%array2) ) then
-        allocate(save_var%array2(save_var%lb(1):save_var%ub(1),  &
-                                 save_var%lb(2):save_var%ub(2)))
-    endif
-!
-    save_var % array2  = q
-    root_var % restore = .true.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Save_ForRestore2D
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Save_ForRestore3D
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic )
-!---------------------------------------------------------------------------------------------------
-    real, dimension(:,:,:), intent(in)      :: q
-    integer,                intent(in)      :: tabvarsindic
-!
-    type(Agrif_Variable),  pointer  :: root_var, save_var
-    integer                         :: indic
-!
-    indic = tabvarsindic
-    if (tabvarsindic >= 0) then
-        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
-            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-        endif
-    endif
-!
-    if (indic <= 0) then
-        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        save_var => Agrif_Curgrid % tabvars(indic)
-        root_var => Agrif_Mygrid % tabvars(indic)
-    endif
-!
-    if ( .not.allocated(save_var%array3) ) then
-        allocate(save_var%array3(save_var%lb(1):save_var%ub(1), &
-                                 save_var%lb(2):save_var%ub(2), &
-                                 save_var%lb(3):save_var%ub(3)))
-    endif
-!
-    save_var % array3  = q
-    root_var % restore = .true.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Save_ForRestore3D
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Save_ForRestore4D
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic )
-!---------------------------------------------------------------------------------------------------
-    real, dimension(:,:,:,:), intent(in)    :: q
-    integer,                  intent(in)    :: tabvarsindic
-!
-    type(Agrif_Variable),  pointer  :: root_var, save_var
-    integer                         :: indic
-!
-    indic = tabvarsindic
-    if (tabvarsindic >= 0) then
-        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
-            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-        endif
-    endif
-!
-    if (indic <= 0) then
-        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        save_var => Agrif_Curgrid % tabvars(indic)
-        root_var => Agrif_Mygrid % tabvars(indic)
-    endif
-!
-    if (.not.allocated(save_var%array4)) then
-        allocate(save_var%array4(save_var%lb(1):save_var%ub(1),&
-                                 save_var%lb(2):save_var%ub(2),&
-                                 save_var%lb(3):save_var%ub(3),&
-                                 save_var%lb(4):save_var%ub(4)))
-    endif
-!
-    save_var % array4  = q
-    root_var % restore = .true.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Save_ForRestore4D
-!===================================================================================================
-!
-end module Agrif_BcFunction
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 10251)
@@ -0,0 +1,1452 @@
+!
+! $Id: modcluster.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module AGRIF_Clustering  
+C
+C
+      Module Agrif_Clustering 
+C
+CCC   Description:
+CCC   Module to create and initialize the grid hierarchy from the 
+CCC   AGRIF_FixedGrids.in file.
+C
+C     Modules used:
+C  
+      Use Agrif_Curgridfunctions 
+      Use Agrif_Init_Vars
+      Use Agrif_Save
+C             
+      IMPLICIT NONE
+C        
+      Contains 
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Cluster_All  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Cluster_All(g,coarsegrid)
+C
+CCC   Description:
+CCC   Subroutine for the clustering. A temporary grid hierarchy, pointed by 
+CCC   coarsegrid, is created.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Pointer arguments    
+      TYPE(AGRIF_grid)     ,pointer   :: g        ! Pointer on the current grid
+      TYPE(AGRIF_rectangle),pointer   :: coarsegrid
+C      
+C     Local pointer         
+      TYPE(AGRIF_lrectangle),pointer  :: parcours 
+      TYPE(AGRIF_grid)      ,pointer  :: newgrid 
+      REAL                            :: g_eps
+      INTEGER                         :: iii
+C      
+      g_eps = huge(1.)
+      do iii = 1 , Agrif_Probdim
+         g_eps = min(g_eps,g%Agrif_d(iii))
+      enddo
+C
+      g_eps = g_eps/100.                  
+C
+C     Necessary condition for clustering 
+      do iii = 1 , Agrif_Probdim
+         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
+     &                   (Agrif_mind(iii)-g_eps)) Return
+      enddo
+C
+      Nullify(coarsegrid%childgrids)
+C
+      Call Agrif_ClusterGridnD(g,coarsegrid) 
+C
+      parcours => coarsegrid % childgrids                   
+C      
+      do while (associated(parcours))
+C      
+C       Newgrid is created. It is a copy of a fine grid created previously by
+C          clustering.      
+        Allocate(newgrid)
+C      
+        Nullify(newgrid%child_grids)
+C
+        do iii = 1 , Agrif_Probdim
+           newgrid % nb(iii) = (parcours % r % imax(iii) - 
+     &                          parcours % r % imin(iii)) *
+     &                          Agrif_Coeffref(iii)
+C        
+           newgrid % Agrif_x(iii) = g%Agrif_x(iii) + 
+     &                         (parcours %r % imin(iii) -1) 
+     &                         *g%Agrif_d(iii)
+C 
+           newgrid % Agrif_d(iii) = g%Agrif_d(iii) / Agrif_Coeffref(iii)
+C
+        enddo
+C
+        if ( Agrif_Probdim .EQ. 1 ) then
+           allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
+           newgrid%tabpoint1D = 0
+        endif
+C
+        if ( Agrif_Probdim .EQ. 2 ) then
+           allocate(newgrid%tabpoint2D(newgrid%nb(1)+1,
+     &                                 newgrid%nb(2)+1))
+           newgrid%tabpoint2D = 0      
+        endif
+C
+        if ( Agrif_Probdim .EQ. 3 ) then
+           allocate(newgrid%tabpoint3D(newgrid%nb(1)+1,
+     &                                 newgrid%nb(2)+1,
+     &                                 newgrid%nb(3)+1))
+           newgrid%tabpoint3D = 0
+        endif
+C       Points detection on newgrid
+        Call Agrif_TabpointsnD(Agrif_mygrid,newgrid) 
+C
+C       Recursive call to Agrif_Cluster_All            
+        Call Agrif_Cluster_All (newgrid, parcours % r)     
+C
+        parcours => parcours % next 
+C      
+        if ( Agrif_Probdim .EQ. 1 ) Deallocate(newgrid%tabpoint1D)
+        if ( Agrif_Probdim .EQ. 2 ) Deallocate(newgrid%tabpoint2D)
+        if ( Agrif_Probdim .EQ. 3 ) Deallocate(newgrid%tabpoint3D)
+C
+        Deallocate(newgrid)   
+C
+      enddo
+C
+C      
+      End Subroutine Agrif_Cluster_All
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_TabpointsnD
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_TabpointsnD(g,newgrid)
+C
+CCC   Description:
+CCC   Copy on newgrid of points detected on the grid hierarchy pointed by g.   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments
+      TYPE(Agrif_Grid),pointer   :: g,newgrid
+C
+C     Local variables      
+      TYPE(Agrif_Pgrid),pointer  :: parcours
+C
+      REAL                  :: g_eps,newgrid_eps,eps
+      REAL   , DIMENSION(3) :: newmin,newmax
+      REAL   , DIMENSION(3) :: gmin,gmax
+      REAL   , DIMENSION(3) :: xmin
+      INTEGER, DIMENSION(3) :: igmin,inewmin
+      INTEGER, DIMENSION(3) :: inewmax
+      INTEGER               :: iii
+      INTEGER               :: i,j,k
+      INTEGER               :: i0,j0,k0
+C
+C     
+      parcours => g % child_grids
+C
+      do While(associated(parcours))
+        Call Agrif_TabpointsnD(parcours%gr,newgrid)
+        parcours => parcours % next
+      enddo      
+C
+      g_eps = 10.
+      newgrid_eps = 10.
+C      
+      do iii = 1 , Agrif_probdim
+         g_eps = min( g_eps , g % Agrif_d(iii) )
+         newgrid_eps = min(newgrid_eps,newgrid%Agrif_d(iii))
+      enddo
+C
+      eps = min(g_eps,newgrid_eps)/100.                  
+C                   
+      do iii = 1 , Agrif_probdim
+         if (newgrid%Agrif_d(iii) .LT. (g%Agrif_d(iii)-eps)) Return
+C                   
+         gmin(iii) = g%Agrif_x(iii)
+         gmax(iii) = g%Agrif_x(iii) + g%nb(iii) * g%Agrif_d(iii)
+C 
+         newmin(iii) = newgrid%Agrif_x(iii)
+         newmax(iii) = newgrid%Agrif_x(iii) + newgrid%nb(iii) *
+     &                 newgrid%Agrif_d(iii)
+C      
+         if (gmax(iii) .LT. newmin(iii)) Return
+C
+         if (gmin(iii) .GT. newmax(iii)) Return
+C           
+         inewmin(iii) = 1 - floor(-(max(gmin(iii),newmin(iii))-
+     &                    newmin(iii))
+     &                   /newgrid%Agrif_d(iii)) 
+C          
+         xmin(iii) = newgrid%Agrif_x(iii) + (inewmin(iii)-1)*
+     &              newgrid%Agrif_d(iii)          
+C        
+         igmin(iii) = 1 + nint((xmin(iii)-gmin(iii))/g%Agrif_d(iii))
+C
+         inewmax(iii) = 1 + int((min(gmax(iii),newmax(iii))-
+     &                  newmin(iii))/newgrid%Agrif_d(iii))
+      enddo
+C                
+      if ( Agrif_probdim .EQ. 1 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            newgrid%tabpoint1D(i) = max(
+     &                           newgrid%tabpoint1D(i),
+     &                           g%tabpoint1D(i0))
+         enddo
+         i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+      endif
+C
+      if ( Agrif_probdim .EQ. 2 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+               newgrid%tabpoint2D(i,j) = max(
+     &                           newgrid%tabpoint2D(i,j),
+     &                           g%tabpoint2D(i0,j0))
+               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+         enddo
+      endif
+C
+      if ( Agrif_probdim .EQ. 3 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+               k0 = igmin(3)
+               do k = inewmin(3),inewmax(3)
+                  newgrid%tabpoint3D(i,j,k) = max(
+     &                           newgrid%tabpoint3D(i,j,k),
+     &                           g%tabpoint3D(i0,j0,k0))
+                  k0 = k0 + int(newgrid%Agrif_d(3)/g%Agrif_d(3))
+               enddo                                        
+               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+         enddo
+      endif
+C
+      Return
+C
+C
+      End Subroutine Agrif_TabpointsnD
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ClusterGridnD
+C     **************************************************************************
+C      
+      Subroutine Agrif_ClusterGridnD(g,coarsegrid)
+C
+CCC   Description:
+CCC   Clustering on the grid pointed by g.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Pointer arguments
+      TYPE(AGRIF_grid)     ,pointer  :: g          ! Pointer on the current grid
+      TYPE(AGRIF_rectangle),pointer  :: coarsegrid
+C
+C     Local variables      
+      TYPE(Agrif_rectangle) :: newrect
+      TYPE(Agrif_Variable)  :: newflag
+C
+      INTEGER               :: i,j,k
+      INTEGER ,DIMENSION(3) :: sx
+      INTEGER               :: bufferwidth,flagpoints
+      INTEGER               :: n1,n2,m1,m2,o1,o2
+      INTEGER               :: iii
+C
+C      
+      bufferwidth = int(Agrif_Minwidth/5.)
+C      
+      do iii = 1 , Agrif_probdim
+         sx(iii) = g % nb(iii) + 1
+      enddo
+C                  
+      if ( Agrif_probdim .EQ. 1 ) then
+         allocate(newflag%iarray1(sx(1)))
+         newflag%iarray1 = 0      
+      endif
+      if ( Agrif_probdim .EQ. 2 ) then
+         allocate(newflag%iarray2(sx(1),sx(2)))
+         newflag%iarray2 = 0      
+      endif
+      if ( Agrif_probdim .EQ. 3 ) then
+         allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
+         newflag%iarray3 = 0      
+      endif
+C
+      flagpoints = 0 
+C      
+      if (bufferwidth>0) then 
+C      
+         if ( Agrif_probdim .EQ. 1 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1      
+               if (g % tabpoint1D(i) .EQ. 1) then
+                  m1 = i - bufferwidth + 1
+                  m2 = i + bufferwidth - 1                  
+                  flagpoints = flagpoints + 1
+                  newflag%iarray1(m1:m2)=1 
+               endif 
+            enddo    
+         endif
+C
+        if ( Agrif_probdim .EQ. 2 ) then
+           do i = bufferwidth,sx(1)-bufferwidth+1      
+               do j = bufferwidth,sx(2)-bufferwidth+1
+                  if (g % tabpoint2D(i,j) .EQ. 1) then
+                     n1 = j - bufferwidth + 1
+                     n2 = j + bufferwidth - 1
+                     m1 = i - bufferwidth + 1
+                     m2 = i + bufferwidth - 1                  
+                     flagpoints = flagpoints + 1
+                     newflag%iarray2(m1:m2,n1:n2)=1 
+                  endif  
+               enddo    
+            enddo
+         endif
+C
+        if ( Agrif_probdim .EQ. 3 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1      
+               do j = bufferwidth,sx(2)-bufferwidth+1
+                  do k = bufferwidth,sx(3)-bufferwidth+1
+                     if (g % tabpoint3D(i,j,k) .EQ. 1) then
+                        o1 = k - bufferwidth + 1
+                        o2 = k + bufferwidth - 1
+                        n1 = j - bufferwidth + 1
+                        n2 = j + bufferwidth - 1
+                        m1 = i - bufferwidth + 1
+                        m2 = i + bufferwidth - 1                  
+                        flagpoints = flagpoints + 1
+                        newflag%iarray3(m1:m2,n1:n2,o1:o2)=1 
+                     endif 
+                  enddo  
+               enddo    
+            enddo
+        endif
+      else
+          flagpoints = 1       
+C
+          if ( Agrif_probdim .EQ. 1 ) then
+          newflag%iarray1 = g % tabpoint1D
+          endif
+          if ( Agrif_probdim .EQ. 2 ) then
+          newflag%iarray2 = g % tabpoint2D
+          endif
+          if ( Agrif_probdim .EQ. 3 ) then
+          newflag%iarray3 = g % tabpoint3D
+          endif
+      endif
+C       
+      if (flagpoints .EQ. 0) then       
+          if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1) 
+          if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2) 
+          if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3) 
+          Return 
+      endif       
+C      
+      do iii = 1 , Agrif_probdim
+         newrect % imin(iii) = 1
+         newrect % imax(iii) = sx(iii)
+      enddo
+C      
+      Call Agrif_Clusternd(newflag,
+     &                     coarsegrid%childgrids,newrect) 
+C      
+      if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1)
+      if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2)
+      if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3)
+C  
+C    
+      End Subroutine Agrif_ClusterGridnD
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ClusternD
+C     **************************************************************************
+C
+      Recursive subroutine Agrif_Clusternd(flag,boxlib,oldB) 
+C
+CCC   Description:
+CCC   Clustering on the grid pointed by oldB.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments  
+      TYPE(Agrif_rectangle) ::  oldB    
+      TYPE(Agrif_Variable)  :: flag
+c      INTEGER,DIMENSION(oldB%imin(1):oldB%imax(1),
+c     &                  oldB%imin(2):oldB%imax(2)) :: flag
+      TYPE(Agrif_lrectangle),pointer :: boxlib      
+C
+C     Local variables      
+      TYPE(Agrif_lrectangle),pointer :: tempbox,parcbox,parcbox2       
+      TYPE(Agrif_rectangle) :: newB,newB2
+      INTEGER :: i,j,k,iii
+      INTEGER,DIMENSION(:),allocatable :: i_sig 
+      INTEGER,DIMENSION(:),allocatable :: j_sig       
+      INTEGER,DIMENSION(:),allocatable :: k_sig       
+      INTEGER,DIMENSION(3) :: ipu,ipl
+      INTEGER,DIMENSION(3) :: istr,islice
+      REAL :: cureff
+      REAL :: neweff
+      INTEGER :: ValMax,ValSum,TailleTab
+      INTEGER :: nbpoints,nbpointsflag  
+      LOGICAL :: test
+C          
+      allocate(i_sig(oldB%imin(1):oldB%imax(1)))
+      if ( Agrif_probdim .GE. 2 ) 
+     & allocate(j_sig(oldB%imin(2):oldB%imax(2)))
+      if ( Agrif_probdim .EQ. 3 ) 
+     & allocate(k_sig(oldB%imin(3):oldB%imax(3)))
+C
+      test = .FALSE.
+      do iii = 1 , Agrif_probdim
+         test = test .OR. ( (oldB%imax(iii)-oldB%imin(iii)+1) 
+     &                    .LT. Agrif_Minwidth)
+      enddo
+      if ( test ) Return
+C     
+      if ( Agrif_probdim .EQ. 1 ) i_sig = flag%iarray1
+      if ( Agrif_probdim .EQ. 2 ) then
+         do i = oldB%imin(1),oldB%imax(1)
+           i_sig(i) = SUM(flag%iarray2(i,
+     &                            oldB%imin(2):oldB%imax(2)))
+         enddo
+         do j = oldB%imin(2),oldB%imax(2)
+           j_sig(j) = SUM(flag%iarray2(
+     &                            oldB%imin(1):oldB%imax(1),j))
+         enddo      
+      endif
+      if ( Agrif_probdim .EQ. 3 ) then
+         do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray3(i,
+     &                            oldB%imin(2):oldB%imax(2),
+     &                            oldB%imin(3):oldB%imax(3)))
+         enddo
+         do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray3(
+     &                          oldB%imin(1):oldB%imax(1),j,
+     &                          oldB%imin(3):oldB%imax(3)))
+         enddo
+         do k = oldB%imin(3),oldB%imax(3)
+            k_sig(k) = SUM(flag%iarray3(
+     &                          oldB%imin(1):oldB%imax(1),
+     &                          oldB%imin(2):oldB%imax(2),k))
+         enddo      
+      endif
+C                    
+      do iii = 1 , Agrif_probdim
+         ipl(iii) = oldB%imin(iii)
+         ipu(iii) = oldB%imax(iii)
+      enddo
+C           
+      Call Agrif_Clusterprune(i_sig,ipl(1),ipu(1)) 
+      if ( Agrif_probdim .GE. 2 ) 
+     &   Call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))      
+      if ( Agrif_probdim .EQ. 3 ) 
+     &   Call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))      
+C     
+      test = .TRUE.
+      do iii = 1 , Agrif_probdim
+         test = test .AND. (ipl(iii).EQ.oldB%imin(iii))
+         test = test .AND. (ipu(iii).EQ.oldB%imax(iii))
+      enddo
+      
+      if (.NOT. test) then 
+          do iii = 1 , Agrif_probdim
+             newB%imin(iii) = ipl(iii)
+             newB%imax(iii) = ipu(iii)
+          enddo
+C        
+          if ( Agrif_probdim .EQ. 1 ) 
+     &       nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))   
+          if ( Agrif_probdim .EQ. 2 ) 
+     &       nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),
+     &                           newB%imin(2):newB%imax(2)))   
+          if ( Agrif_probdim .EQ. 3 ) 
+     &       nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),
+     &                           newB%imin(2):newB%imax(2),   
+     &                           newB%imin(3):newB%imax(3)))
+C   
+          if ( Agrif_probdim .EQ. 1 ) 
+     &       TailleTab = newB%imax(1)-newB%imin(1)+1
+          if ( Agrif_probdim .EQ. 2 ) 
+     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                   (newB%imax(2)-newB%imin(2)+1)
+          if ( Agrif_probdim .EQ. 3 ) 
+     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                   (newB%imax(2)-newB%imin(2)+1)*
+     &                   (newB%imax(3)-newB%imin(3)+1)
+C
+          neweff = REAL(nbpoints)/TailleTab
+C     
+          if (nbpoints.GT.0) then
+C        
+              if ((neweff .GT .Agrif_efficiency)) then
+                  Call Agrif_Add_Rectangle(newB,boxlib)
+                  Return
+              else
+C            
+                  tempbox => boxlib
+                  newB2 = newB
+                  Call Agrif_Clusternd(flag,
+     &                      boxlib,newB)
+C     
+C                 Compute new efficiency
+C
+                  cureff = neweff
+                  parcbox2 => boxlib
+                  nbpoints = 0
+                  nbpointsflag = 0
+C
+                  do While (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) Exit
+                    newB = parcbox2%r
+C
+                    if ( Agrif_probdim .EQ. 1 ) Valsum = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim .EQ. 2 ) Valsum = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim .EQ. 3 ) Valsum = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C
+                    nbpointsflag = nbpointsflag + ValSum
+                    if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+                    if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next  
+                  enddo  
+C coefficient 1.05 avant 1.15 possibilité de laisser choix à l utilisateur
+                  if  (REAL(nbpointsflag)/REAL(nbpoints)
+     &                 .LT.(1.0001*cureff)) then
+                      parcbox2 => boxlib            
+                      do While (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) Exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next             
+                      enddo      
+                      boxlib => tempbox
+                      Call Agrif_Add_Rectangle(newB2,boxlib)
+                      Return
+                  endif
+              endif         
+          endif
+          Return
+      endif 
+C       
+      do iii = 1 , Agrif_Probdim
+         istr(iii) = oldB%imax(iii)
+         islice(iii) = oldB%imin(iii)
+      enddo     
+C      
+      Call Agrif_Clusterslice(i_sig,islice(1),istr(1)) 
+      if ( Agrif_probdim .GE. 2 ) 
+     & Call Agrif_Clusterslice(j_sig,islice(2),istr(2)) 
+      if ( Agrif_probdim .EQ. 3 ) 
+     & Call Agrif_Clusterslice(k_sig,islice(3),istr(3)) 
+C      
+      ValSum = 0
+      do iii = 1 , Agrif_Probdim
+         Valsum = valSum + islice(iii)
+      enddo
+C      
+      if ( Valsum .EQ. -Agrif_Probdim ) then 
+          Call Agrif_Add_Rectangle(oldB,boxlib) 
+          Return 
+      endif 
+C       
+      nullify(tempbox)
+      tempbox => boxlib
+      if ( Agrif_probdim .EQ. 1 ) 
+     &      cureff  = oldB%imax(1)-oldB%imin(1)+1
+      if ( Agrif_probdim .EQ. 2 ) 
+     &      cureff  = (oldB%imax(1)-oldB%imin(1)+1)*
+     &                (oldB%imax(2)-oldB%imin(2)+1)
+      if ( Agrif_probdim .EQ. 3 ) 
+     &       cureff = (oldB%imax(1)-oldB%imin(1)+1)*
+     &                (oldB%imax(2)-oldB%imin(2)+1)*
+     &                (oldB%imax(3)-oldB%imin(3)+1)
+      Nullify(parcbox)
+C 
+      do iii = 1 , Agrif_Probdim
+          newB%imax(iii) = oldB%imax(iii)            
+          newB%imin(iii) = oldB%imin(iii)
+      enddo     
+C
+      ValMax = 0
+      do iii = 1 , Agrif_Probdim
+         ValMax = Max(ValMax,istr(iii))
+      enddo
+C
+      if (istr(1) .EQ. ValMax ) then
+          newB%imax(1) = islice(1)
+          Call Agrif_Add_Rectangle(newB,parcbox)                   
+          newB%imin(1) = islice(1)+1
+          newB%imax(1) = oldB%imax(1)
+          Call Agrif_Add_Rectangle(newB,parcbox)
+      elseif ( Agrif_probdim .GE. 2 ) then
+         if (istr(2) .EQ. ValMax ) then
+            newB%imax(2) = islice(2)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(2) = islice(2)+1
+            newB%imax(2) = oldB%imax(2)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+         elseif ( Agrif_probdim .EQ. 3 ) then
+            newB%imax(3) = islice(3)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(3) = islice(3)+1
+            newB%imax(3) = oldB%imax(3)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+         endif
+      endif
+C      
+      do While (associated(parcbox))
+        newB = parcbox%r            
+C
+        if ( Agrif_probdim .EQ. 1 ) nbpoints = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim .EQ. 2 ) nbpoints = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim .EQ. 3 ) nbpoints = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C      
+       if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+       if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+       if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+
+        neweff = REAL(nbpoints) / TailleTab
+C     
+        if (nbpoints .GT. 0) then
+C      
+            if ((neweff .GT .Agrif_efficiency)) then
+                Call Agrif_Add_Rectangle(newB,boxlib)
+            else
+                tempbox => boxlib
+                newB2 = newB
+                Call Agrif_Clusternd(flag,
+     &                      boxlib,newB)
+C
+C               Compute new efficiency
+C
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+C
+                do While (associated(parcbox2))
+                  if (associated(parcbox2,tempbox)) Exit
+                  newB = parcbox2%r
+C
+                  if ( Agrif_probdim .EQ. 1 ) ValSum = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+                  if ( Agrif_probdim .EQ. 2 ) ValSum = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+                  if ( Agrif_probdim .EQ. 3 ) ValSum = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C
+                  nbpointsflag = nbpointsflag + ValSum
+C
+                    if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+                    if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+
+                  nbpoints = nbpoints + TailleTab
+C              
+                  parcbox2 => parcbox2%next  
+                enddo   
+C            
+                if  (REAL(nbpointsflag)/REAL(nbpoints)
+     &               .LT.(1.15*cureff)) then
+                    parcbox2 => boxlib            
+                    do While (associated(parcbox2))
+                      if (associated(parcbox2,tempbox)) Exit
+                      deallocate(parcbox2%r)
+                      parcbox2 => parcbox2%next             
+                    enddo
+                    boxlib => tempbox
+                    Call Agrif_Add_Rectangle(newB2,boxlib)
+                endif
+            endif
+        endif
+        parcbox => parcbox%next
+      enddo
+C      
+C      
+      Return
+C      
+      End Subroutine Agrif_Clusternd 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Clusterslice
+C     **************************************************************************
+C                           
+      Subroutine Agrif_Clusterslice(sig,slice,str) 
+C
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments 
+      INTEGER                      :: slice,str
+      INTEGER,DIMENSION(slice:str) :: sig 
+C
+C     Local variables      
+      INTEGER                      :: ideb,ifin
+      INTEGER                      :: i,t,a,di,ts 
+      INTEGER,DIMENSION(slice:str) :: lap 
+C
+C    
+      ideb = slice
+      ifin = str
+C    
+      if (SIZE(sig) <= 2*Agrif_Minwidth) then
+          str = -1 
+          slice = -1 
+          Return
+      endif
+C      
+      t = -1 
+      a = -1 
+C
+      do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
+          if (sig(i) .EQ. 0) then
+              if ((i-ideb) < (ifin-i)) then
+                  di = i - ideb
+                else 
+                  di = ifin - i 
+              endif
+C
+              if (di > t) then
+                a = i 
+                t = di 
+              endif
+         endif
+      enddo
+C      
+      if (a .NE. (-1)) then
+          slice = a 
+          str = t 
+          Return
+      endif
+C      
+      t = -1 
+      a = -1 
+C      
+      do i = ideb+1,ifin-1 
+        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i) 
+      enddo
+C      
+      do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if ((lap(i+1)*lap(i)) .LE. 0) then
+            ts = ABS(lap(i+1) - lap(i)) 
+            if (ts > t) then
+                t = ts 
+                a = i
+            endif
+       endif
+      enddo
+C      
+      if (a .EQ. (ideb + Agrif_Minwidth - 1)) then
+          a = -1
+          t = -1
+      endif
+C      
+      slice = a 
+      str = t 
+C
+C      
+      End Subroutine Agrif_Clusterslice       
+C
+C
+C    
+C     **************************************************************************
+CCC   Subroutine Agrif_Clusterprune
+C     **************************************************************************
+C      
+      Subroutine Agrif_Clusterprune(sig,pl,pu) 
+C
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments
+      INTEGER                  :: pl,pu 
+      INTEGER,DIMENSION(pl:pu) :: sig
+C
+C     Local variables      
+      INTEGER :: ideb,ifin       
+      INTEGER :: diff,addl,addu,udist,ldist  
+C
+C      
+      ideb = pl
+      ifin = pu
+C      
+      if (SIZE(sig) <= Agrif_Minwidth) then
+          return 
+      endif 
+C       
+      do While ((sig(pl) .EQ. 0) .AND. (pl < ifin)) 
+        pl = pl + 1 
+      enddo 
+C       
+      do While ((sig(pu) .EQ. 0) .AND. (pu > ideb)) 
+        pu = pu - 1 
+      enddo 
+C       
+      if ((pu-pl) < Agrif_Minwidth) then
+          diff = Agrif_Minwidth - (pu - pl + 1) 
+          udist = ifin - pu 
+          ldist = pl - ideb
+          addl = diff / 2 
+          addu = diff - addl 
+          if (addu > udist) then
+              addu = udist 
+              addl = diff - addu 
+          endif
+C         
+          if (addl > ldist) then
+              addl = ldist 
+              addu = diff - addl
+          endif
+C         
+          pu = pu + addu 
+          pl = pl - addl         
+C      
+      endif 
+C       
+C
+      End Subroutine Agrif_Clusterprune
+C
+C
+C              
+C     **************************************************************************
+CCC   Subroutine Agrif_Add_Rectangle 
+C     **************************************************************************
+C        
+      Subroutine Agrif_Add_Rectangle(R,LR)
+C
+CCC   Description:
+CCC   Subroutine to add the Agrif_Rectangle R in a list managed by LR.
+C
+C     Declarations:
+C
+C     Arguments               
+      TYPE(AGRIF_rectangle)           :: R  
+      TYPE(AGRIF_lrectangle), Pointer :: LR
+C
+C     Local variable        
+      TYPE(AGRIF_lrectangle), Pointer :: newrect  
+C
+      INTEGER                         :: iii 
+C
+C        
+      allocate(newrect)
+      allocate(newrect % r)
+C
+      newrect % r = R
+C      
+      do iii = 1 , Agrif_Probdim
+         newrect % r % spaceref(iii) = Agrif_Coeffref(iii)
+         newrect % r % timeref(iii) = Agrif_Coeffreft(iii)
+      enddo
+C              
+      newrect % r % number = -1            
+      Nullify(newrect % r % childgrids)
+      newrect % next => LR  
+      LR => newrect  
+C
+C      
+      End Subroutine Agrif_Add_Rectangle   
+C  
+C
+C  
+C     **************************************************************************
+CCC   Subroutine Agrif_Read_Fix_Grd  
+C     **************************************************************************
+C      
+      Recursive Subroutine Agrif_Read_Fix_Grd(coarsegrid,j,nunit)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy from the reading of the 
+CCC   AGRIF_FixedGrids.in file.
+C
+CC    Method:
+CC    Recursive subroutine and creation of a first grid hierarchy from the
+CC    reading of the AGRIF_FixedGrids.in file.        
+C
+C     Declarations:
+C
+C     Pointer argument      
+      TYPE(AGRIF_rectangle), Pointer   :: coarsegrid ! Pointer on the first grid
+                                                     ! of the grid hierarchy
+C                                    
+C     Scalar arguments                                    
+      INTEGER                          :: j          ! Number of the new grid
+      INTEGER                          :: nunit      ! unit associated with file
+C      
+C     Local variables      
+      TYPE(AGRIF_rectangle)            :: newrect    ! Pointer on a new grid   
+      TYPE(AGRIF_lrectangle), Pointer  :: parcours   ! Pointer for the recursive
+                                                     !    procedure
+      TYPE(AGRIF_lrectangle), Pointer  :: newlrect
+      TYPE(AGRIF_lrectangle), Pointer  :: end_list       
+      INTEGER                          :: i          ! for each child grid
+      INTEGER                          :: nb_grids   ! Number of child grids
+      INTEGER                          :: iii
+C          
+C
+      Nullify(newrect%childgrids)
+C      
+C     Reading of the number of child grids        
+      read(nunit,*) nb_grids
+C      
+C     coarsegrid%nbgridchild = nb_grids
+C      
+      allocate(end_list)
+C
+      nullify(end_list % r)
+      nullify(end_list % next)
+C      
+      coarsegrid % childgrids => end_list
+C
+C     Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
+C        time refinement factors for each child grid.
+C     Creation and addition of the new grid to the grid hierarchy. 
+C
+      do i = 1,nb_grids
+        allocate(newlrect)      
+        newrect % number = j   ! Number of the grid
+C
+        if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+           if (Agrif_Probdim == 3) then  
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % imin(2), newrect % imax(2),
+     &                    newrect % imin(3), newrect % imax(3),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % spaceref(3),
+     &                    newrect % timeref(1),newrect % timeref(2),
+     &                    newrect % timeref(3)
+           elseif (Agrif_Probdim == 2) then            
+            read(nunit,*) newrect % imin(1),newrect % imax(1),
+     &                  newrect % imin(2),newrect % imax(2),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % timeref(1),newrect % timeref(2)
+           elseif (Agrif_Probdim == 1) then
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % spaceref(1),
+     &                    newrect % timeref(1)
+           endif
+        else
+           if (Agrif_Probdim == 3) then  
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % imin(2), newrect % imax(2),
+     &                    newrect % imin(3), newrect % imax(3),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % spaceref(3),
+     &                    newrect % timeref(1)
+           elseif (Agrif_Probdim == 2) then            
+            read(nunit,*) newrect % imin(1),newrect % imax(1),
+     &                  newrect % imin(2),newrect % imax(2),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % timeref(1)
+           elseif (Agrif_Probdim == 1) then
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % spaceref(1),
+     &                    newrect % timeref(1)
+           endif
+C
+           if ( Agrif_probdim .GE. 2 ) then
+              do iii = 2 , Agrif_probdim
+                 newrect % timeref(iii) = newrect % timeref(1) 
+              enddo
+           endif
+C
+        endif
+C
+C       Addition to the grid hierarchy
+C
+        nullify(newrect % childgrids)
+        j = j + 1
+        Allocate(newlrect%r)
+        newlrect % r = newrect 
+        nullify(newlrect % next)
+        end_list % next => newlrect
+        end_list => end_list % next
+      enddo
+C      
+      coarsegrid % childgrids => coarsegrid % childgrids % next
+      parcours => coarsegrid % childgrids
+C
+C     Recursive operation to create the grid hierarchy branch by branch
+C
+      do while (associated(parcours))
+        call Agrif_Read_Fix_Grd (parcours % r,j,nunit)
+        parcours => parcours % next
+      enddo
+C      
+C
+      End Subroutine Agrif_Read_Fix_Grd        
+C        
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Create_Grids  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Create_Grids(g,coarsegrid)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy (g) from the one created with the
+CCC   Agrif_Read_Fix_Grd or Agrif_Cluster_All procedures (coarsegrid).
+C
+CC    Method:
+CC    Recursive subroutine.        
+C
+C     Declarations:
+C
+C     Pointer arguments        
+      TYPE(AGRIF_grid)     , Pointer  :: g          ! Pointer on the root coarse
+                                                    ! grid
+      TYPE(AGRIF_rectangle), Pointer  :: coarsegrid ! Pointer on the root coarse
+                                                    ! grid of the grid hierarchy
+                                                    ! created with the
+                                                    ! Agrif_Read_Fix_Grd
+                                                    ! subroutine
+C
+C     Local pointers
+      TYPE(Agrif_grid)      , Pointer :: newgrid    ! New grid
+      TYPE(Agrif_pgrid)     , Pointer :: newpgrid
+      TYPE(Agrif_pgrid)     , Pointer :: parcours2
+      TYPE(Agrif_lrectangle), Pointer :: parcours
+      TYPE(Agrif_pgrid)     , Pointer :: end_list
+      TYPE(Agrif_pgrid)     , Pointer :: parcours3
+C
+C     Local scalars      
+      LOGICAL                         :: nullliste
+      INTEGER                         :: iii
+      INTEGER                         :: moving_grid_id = 0      
+
+C
+      parcours3 => g % child_grids
+C     
+      if (associated(parcours3)) then
+          do While (associated(parcours3 % next))
+            parcours3 => parcours3 % next
+          enddo
+          end_list => parcours3
+          nullliste=.FALSE.
+        else
+          allocate(end_list)
+          nullify(end_list % gr)
+          nullify(end_list % next)      
+          g % child_grids => end_list 
+          parcours3 => end_list      
+          nullliste=.TRUE.
+      endif
+C      
+      parcours => coarsegrid % childgrids
+C      
+C     Creation of the grid hierarchy from the one created by using the 
+C     Agrif_Read_Fix_Grd subroutine 
+C
+      do while (associated(parcours))
+        allocate(newgrid)        
+        moving_grid_id=moving_grid_id+1
+        newgrid % grid_id = moving_grid_id
+        do iii = 1 , Agrif_Probdim
+           newgrid % spaceref(iii) = parcours % r % spaceref(iii)
+           newgrid % timeref(iii) = parcours % r % timeref(iii)
+        enddo
+C
+        do iii = 1 , Agrif_Probdim
+          newgrid % nb(iii) = (parcours % r % imax(iii) 
+     &                       - parcours % r % imin(iii)) 
+     &                       * parcours % r % spaceref(iii)
+C     
+          newgrid % ix(iii) =  parcours % r % imin(iii)
+C
+          newgrid % Agrif_d(iii) = g % Agrif_d(iii) 
+     &                  / REAL(newgrid % spaceref(iii))
+C
+          newgrid % Agrif_x(iii) = g % Agrif_x(iii) +
+     &      (parcours % r % imin(iii) - 1)* g % Agrif_d(iii)
+C      
+        enddo
+C
+C       Pointer on the parent grid                        
+C
+        newgrid % parent => g      
+
+C       Level of the current grid
+        newgrid % level = newgrid % parent % level + 1
+        if (newgrid % level > Agrif_MaxLevelLoc) then
+          Agrif_MaxLevelLoc = newgrid%level
+        endif
+
+C      
+C       Grid pointed by newgrid is a fixed grid      
+C
+        if (parcours % r % number .GT. 0) then      
+            newgrid % fixed = .true.  
+          else
+            newgrid % fixed = .false.
+        endif
+C
+C       Number of the grid pointed by newgrid
+        newgrid % fixedrank = parcours % r % number
+C           
+C       No time calculation on this grid         
+        newgrid % ngridstep = 0      
+C
+C       Test indicating if the current grid has a common border with the root 
+C       coarse grid in the x direction
+        do iii = 1 , Agrif_Probdim
+           newgrid % NearRootBorder(iii) = .FALSE.
+C        
+           if ((newgrid % parent % NearRootBorder(iii)) .AND. 
+     &         (newgrid % ix(iii) == 1)) then
+               newgrid % NearRootBorder(iii) = .TRUE.
+           endif
+C
+           newgrid % DistantRootBorder(iii) = .FALSE.
+C 
+           if ((newgrid % parent % DistantRootBorder(iii)) .AND. 
+     &         (newgrid % ix(iii) + 
+     &         (newgrid % nb(iii)/newgrid % spaceref(iii))  
+     &          - 1  == newgrid % parent % nb(iii))) then
+               newgrid % DistantRootBorder(iii) = .TRUE.
+           endif
+        enddo
+C
+C       Writing in output files
+C
+        newgrid % oldgrid = .FALSE.      
+C
+C     
+C       Definition of the CHARACTERistics of the variable of the grid pointed by
+C       newgrid 
+        Call Agrif_Create_Var (newgrid)
+C      
+C       Instanciation of the grid pointed by newgrid and its variables
+        Call Agrif_Instance (newgrid)
+C       
+C       Nullify the variable of the grid pointed by newgrid
+C
+C
+C       Addition of this grid to the grid hierarchy 
+C      
+        nullify(newgrid % child_grids)
+        allocate(newpgrid)  
+        newpgrid % gr => newgrid
+        nullify(newpgrid % next)
+        end_list % next => newpgrid
+        end_list => end_list % next               
+        parcours => parcours % next
+C
+C       Updating the total number of fixed grids
+        if (newgrid % fixed) then
+            AGRIF_nbfixedgrids = AGRIF_nbfixedgrids + 1
+        endif
+C                  
+      enddo
+C
+C
+      if (nullliste) then
+          g % child_grids => g % child_grids % next
+          parcours2 => g % child_grids
+          deallocate(parcours3)
+        else
+          parcours2 => parcours3 % next
+      endif
+C      
+      parcours => coarsegrid % childgrids
+C
+C     Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the
+C     grid hierarchy
+C      
+      do while (associated(parcours))
+        Call Agrif_Create_Grids (parcours2 % gr,parcours % r)
+        parcours => parcours % next
+        parcours2 => parcours2 % next
+      enddo 
+C      
+      Return      
+C                  
+      End Subroutine Agrif_Create_Grids
+C
+C      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_Hierarchy  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Init_Hierarchy(g) 
+C
+CCC   Description:
+CCC   Subroutine to initialize all the grids except the root coarse grid (this 
+CCC   one, pointed by AGRIF_mygrid, is initialized by the subroutine 
+CCC   Agrif_Init_Grids defi ned in the module Agrif_Util and called in the main 
+CCC   program ). 
+C
+CC    Method:
+CC    Recursive subroutine.        
+C
+C     Declarations:
+C
+C     Pointer argument      
+      TYPE(AGRIF_grid), Pointer  :: g         ! Pointer on the root coarse grid 
+C      
+C     Local variables      
+      TYPE(AGRIF_pgrid), Pointer :: parcours  ! Pointer for the recursive call
+      LOGICAL                    :: Init_Hierarchy
+C      
+C
+      parcours=>g%child_grids
+C      
+      do while (associated(parcours))
+        Init_Hierarchy = .false.
+        if ( AGRIF_USE_FIXED_GRIDS .EQ. 1 .OR. 
+     &       AGRIF_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+           if ((parcours%gr%fixed) 
+     &         .AND. (Agrif_mygrid%ngridstep == 0)) then
+              Init_Hierarchy = .true.
+           endif      
+       endif
+C
+       if (.NOT. parcours%gr%fixed) Init_Hierarchy = .true.
+       if (parcours % gr % oldgrid) Init_Hierarchy = .false.
+C
+       if (Init_Hierarchy) then 
+C
+C           Instanciation of the grid pointed by parcours%gr and its variables 
+            Call Agrif_Instance (parcours % gr)
+C    
+C           Allocation of the arrays containing values of the variables of the
+C           grid pointed by parcours%gr      
+C      
+            Call Agrif_Allocation (parcours % gr)   
+C            
+            Call Agrif_initialisations(parcours % gr)              
+C       
+            Call Agrif_Instance(parcours % gr)
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+              Call Agrif_Allocate_Restore (parcours % gr)
+            endif
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C              Initialization by copy of the grids created by clustering 
+               Call AGRIF_CopyFromold_All (parcours%gr,
+     &                                     Agrif_oldmygrid)
+            endif
+C
+C           Initialization by interpolation 
+C           (this routine is written by the user) 
+            Call Agrif_InitValues()
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+               Call Agrif_Free_Restore (parcours % gr)
+            endif
+C
+       endif                                  
+       parcours => parcours % next 
+C         
+      enddo
+C
+      parcours => g % child_grids
+C      
+C     Recursive operation to initialize all the grids
+      do while (associated(parcours))
+        Call Agrif_Init_Hierarchy (parcours%gr)
+        parcours => parcours%next
+      enddo
+C      
+      End Subroutine Agrif_Init_Hierarchy 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Allocate_Restore  
+C     **************************************************************************
+C
+      Subroutine Agrif_Allocate_Restore(Agrif_Gr)
+C      
+C      
+C     Modules used:
+C
+      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
+C     
+      INTEGER                    :: i
+C
+        do i = 1 , Agrif_NbVariables
+            if ( Agrif_Mygrid%tabvars(i)%var % restaure ) then
+            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 1 ) then    
+            Allocate( Agrif_Gr%tabvars(i)%var%  
+     &    Restore1D(lbound(Agrif_Gr%tabvars(i)%var%array1,1) 
+     &    :ubound(Agrif_Gr%tabvars(i)%var%array1,1))) 
+            Agrif_Gr%tabvars(i)%var%Restore1D = 0
+C
+            endif
+            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 2 ) then
+            Allocate( Agrif_Gr%tabvars(i)%var%Restore2D(  
+     &      lbound(Agrif_Gr%tabvars(i)%var%array2,1):         
+     &      ubound(Agrif_Gr%tabvars(i)%var%array2,1),         
+     &      lbound(Agrif_Gr%tabvars(i)%var%array2,2)          
+     &      :ubound(Agrif_Gr%tabvars(i)%var%array2,2)))         
+            Agrif_Gr%tabvars(i)%var%Restore2D = 0
+C
+            endif
+            if ( Agrif_Mygrid%tabvars(i)%var % nbdim .EQ. 3 ) then
+C     
+            Allocate( Agrif_Gr%tabvars(i)%var%Restore3D( 
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,1):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,1),        
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,2):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,2),        
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,3):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,3)))  
+            Agrif_Gr%tabvars(i)%var%Restore3D = 0
+            endif
+C 
+            endif
+          enddo
+C
+      Return
+C
+C      
+      End Subroutine Agrif_Allocate_Restore      
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_Restore  
+C     **************************************************************************
+C
+      Subroutine Agrif_Free_Restore(Agrif_Gr)
+C
+C      
+C     Pointer argument      
+      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
+      INTEGER :: i     
+C
+      do i = 1 , Agrif_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
+C  
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore1D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore1D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore2D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore2D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore3D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore3D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore4D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore4D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore5D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore5D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore6D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore6D)
+            endif
+C 
+        endif
+      enddo
+C 
+      Return
+C
+C      
+      End Subroutine Agrif_Free_Restore
+C
+C
+C
+      End Module Agrif_Clustering
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 10250)
+++ 	(revision )
@@ -1,1277 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_Clustering
-!>
-!> Contains subroutines to create and initialize the grid hierarchy from the
-!> AGRIF_FixedGrids.in file.
-!
-module Agrif_Clustering
-!
-    use Agrif_CurgridFunctions
-    use Agrif_Init_Vars
-    use Agrif_Save
-!
-    implicit none
-!
-    abstract interface
-        subroutine init_proc()
-        end subroutine init_proc
-    end interface
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_Cluster_All
-!
-!> Subroutine for the clustering. A temporary grid hierarchy, pointed by parent_rect, is created.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Cluster_All ( g, parent_rect )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Grid)     , pointer   :: g        !< Pointer on the current grid
-    TYPE(Agrif_Rectangle), pointer   :: parent_rect
-!
-    TYPE(Agrif_LRectangle), pointer  :: parcours
-    TYPE(Agrif_Grid)      , pointer  :: newgrid
-    REAL                             :: g_eps
-    INTEGER                          :: i
-!
-    g_eps = huge(1.)
-    do i = 1,Agrif_Probdim
-        g_eps = min(g_eps, g % Agrif_dx(i))
-    enddo
-!
-    g_eps = g_eps / 100.
-!
-!   Necessary condition for clustering
-    do i = 1,Agrif_Probdim
-        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps)) return
-    enddo
-!
-    nullify(parent_rect%childgrids)
-!
-    call Agrif_ClusterGridnD(g,parent_rect)
-!
-    parcours => parent_rect % childgrids
-!
-    do while ( associated(parcours) )
-!
-!       Newgrid is created. It is a copy of a fine grid created previously by clustering.
-        allocate(newgrid)
-!
-        do i = 1,Agrif_Probdim
-            newgrid % nb(i) = (parcours % r % imax(i) - parcours % r % imin(i)) * Agrif_Coeffref(i)
-            newgrid % Agrif_x(i)  = g % Agrif_x(i)  + (parcours % r % imin(i) -1) * g%Agrif_dx(i)
-            newgrid % Agrif_dx(i) = g % Agrif_dx(i) / Agrif_Coeffref(i)
-        enddo
-!
-        if ( Agrif_Probdim == 1 ) then
-            allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
-            newgrid%tabpoint1D = 0
-        endif
-!
-        if ( Agrif_Probdim == 2 ) then
-            allocate(newgrid%tabpoint2D(newgrid%nb(1)+1, newgrid%nb(2)+1))
-            newgrid%tabpoint2D = 0
-        endif
-!
-        if ( Agrif_Probdim == 3 ) then
-            allocate(newgrid%tabpoint3D(newgrid%nb(1)+1, newgrid%nb(2)+1, newgrid%nb(3)+1))
-            newgrid%tabpoint3D = 0
-        endif
-!
-!       Points detection on newgrid
-        call Agrif_TabpointsnD(Agrif_mygrid,newgrid)
-!
-!       recursive call to Agrif_Cluster_All
-        call Agrif_Cluster_All(newgrid, parcours % r)
-!
-        parcours => parcours % next
-!
-        if ( Agrif_Probdim == 1 ) deallocate(newgrid%tabpoint1D)
-        if ( Agrif_Probdim == 2 ) deallocate(newgrid%tabpoint2D)
-        if ( Agrif_Probdim == 3 ) deallocate(newgrid%tabpoint3D)
-!
-        deallocate(newgrid)
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Cluster_All
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_TabpointsnD
-!
-!> Copy on newgrid of points detected on the grid hierarchy pointed by g.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_TabpointsnD ( g, newgrid )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Grid), pointer   :: g, newgrid
-!
-    TYPE(Agrif_PGrid), pointer  :: parcours
-!
-    REAL                  :: g_eps, newgrid_eps, eps
-    REAL   , DIMENSION(3) :: newmin, newmax
-    REAL   , DIMENSION(3) :: gmin, gmax
-    REAL   , DIMENSION(3) :: xmin
-    INTEGER, DIMENSION(3) :: igmin, inewmin
-    INTEGER, DIMENSION(3) :: inewmax
-    INTEGER               :: i,  j,  k
-    INTEGER               :: i0, j0, k0
-!
-    parcours => g % child_list % first
-!
-    do while( associated(parcours) )
-        call Agrif_TabpointsnD(parcours%gr,newgrid)
-        parcours => parcours % next
-    enddo
-!
-    g_eps = 10.
-    newgrid_eps = 10.
-!
-    do i = 1,Agrif_probdim
-        g_eps = min( g_eps , g % Agrif_dx(i) )
-        newgrid_eps = min(newgrid_eps,newgrid%Agrif_dx(i))
-    enddo
-!
-    eps = min(g_eps,newgrid_eps)/100.
-!
-    do i = 1,Agrif_probdim
-!
-         if ( newgrid%Agrif_dx(i) < (g%Agrif_dx(i)-eps) ) return
-!
-         gmin(i) = g%Agrif_x(i)
-         gmax(i) = g%Agrif_x(i) + g%nb(i) * g%Agrif_dx(i)
-!
-         newmin(i) = newgrid%Agrif_x(i)
-         newmax(i) = newgrid%Agrif_x(i) + newgrid%nb(i) * newgrid%Agrif_dx(i)
-!
-         if (gmax(i) < newmin(i)) return
-         if (gmin(i) > newmax(i)) return
-!
-         inewmin(i) = 1 - floor(-(max(gmin(i),newmin(i))-newmin(i)) / newgrid%Agrif_dx(i))
-!
-         xmin(i) = newgrid%Agrif_x(i) + (inewmin(i)-1)*newgrid%Agrif_dx(i)
-!
-         igmin(i) = 1 + nint((xmin(i)-gmin(i))/g%Agrif_dx(i))
-!
-         inewmax(i) = 1 + int(   (min(gmax(i),newmax(i))-newmin(i)) / newgrid%Agrif_dx(i))
-!
-    enddo
-!
-    if ( Agrif_probdim == 1 ) then
-        i0 = igmin(1)
-        do i = inewmin(1),inewmax(1)
-            newgrid%tabpoint1D(i) = max( newgrid%tabpoint1D(i), g%tabpoint1D(i0) )
-        enddo
-        i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
-    endif
-!
-    if ( Agrif_probdim == 2 ) then
-        i0 = igmin(1)
-        do i = inewmin(1),inewmax(1)
-            j0 = igmin(2)
-            do j = inewmin(2),inewmax(2)
-                newgrid%tabpoint2D(i,j) = max( newgrid%tabpoint2D(i,j), g%tabpoint2D(i0,j0) )
-                j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2))
-            enddo
-            i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
-        enddo
-    endif
-!
-    if ( Agrif_probdim == 3 ) then
-        i0 = igmin(1)
-        do i = inewmin(1),inewmax(1)
-            j0 = igmin(2)
-            do j = inewmin(2),inewmax(2)
-                k0 = igmin(3)
-                do k = inewmin(3),inewmax(3)
-                    newgrid%tabpoint3D(i,j,k) = max( newgrid%tabpoint3D(i,j,k), g%tabpoint3D(i0,j0,k0))
-                    k0 = k0 + int(newgrid%Agrif_dx(3)/g%Agrif_dx(3))
-                enddo
-                j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2))
-            enddo
-            i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
-        enddo
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_TabpointsnD
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_ClusterGridnD
-!
-!> Clustering on the grid pointed by g.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_ClusterGridnD ( g, parent_rect )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Grid)     , pointer  :: g          !< Pointer on the current grid
-    TYPE(Agrif_Rectangle), pointer  :: parent_rect
-!
-    TYPE(Agrif_Rectangle) :: newrect
-    TYPE(Agrif_Variable_i)  :: newflag
-!
-    INTEGER               :: i,j,k
-    INTEGER, DIMENSION(3) :: sx
-    INTEGER               :: bufferwidth,flagpoints
-    INTEGER               :: n1,n2,m1,m2,o1,o2
-!
-    bufferwidth = int(Agrif_Minwidth/5.)
-!
-    do i = 1,Agrif_probdim
-        sx(i) = g % nb(i) + 1
-    enddo
-!
-    if ( Agrif_probdim == 1 ) then
-        allocate(newflag%iarray1(sx(1)))
-        newflag%iarray1 = 0
-    endif
-    if ( Agrif_probdim == 2 ) then
-        allocate(newflag%iarray2(sx(1),sx(2)))
-        newflag%iarray2 = 0
-    endif
-    if ( Agrif_probdim == 3 ) then
-        allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
-        newflag%iarray3 = 0
-    endif
-!
-    flagpoints = 0
-!
-    if ( bufferwidth>0 ) then
-!
-        if ( Agrif_probdim == 1 ) then
-            do i = bufferwidth,sx(1)-bufferwidth+1
-                if (g % tabpoint1D(i) == 1) then
-                    m1 = i - bufferwidth + 1
-                    m2 = i + bufferwidth - 1
-                    flagpoints = flagpoints + 1
-                    newflag%iarray1(m1:m2) = 1
-                endif
-            enddo
-        endif
-!
-        if ( Agrif_probdim == 2 ) then
-            do i = bufferwidth,sx(1)-bufferwidth+1
-            do j = bufferwidth,sx(2)-bufferwidth+1
-                if (g % tabpoint2D(i,j) == 1) then
-                    n1 = j - bufferwidth + 1
-                    n2 = j + bufferwidth - 1
-                    m1 = i - bufferwidth + 1
-                    m2 = i + bufferwidth - 1
-                    flagpoints = flagpoints + 1
-                    newflag%iarray2(m1:m2,n1:n2) = 1
-                endif
-            enddo
-            enddo
-        endif
-!
-        if ( Agrif_probdim == 3 ) then
-            do i = bufferwidth,sx(1)-bufferwidth+1
-            do j = bufferwidth,sx(2)-bufferwidth+1
-            do k = bufferwidth,sx(3)-bufferwidth+1
-                if (g % tabpoint3D(i,j,k) == 1) then
-                    o1 = k - bufferwidth + 1
-                    o2 = k + bufferwidth - 1
-                    n1 = j - bufferwidth + 1
-                    n2 = j + bufferwidth - 1
-                    m1 = i - bufferwidth + 1
-                    m2 = i + bufferwidth - 1
-                    flagpoints = flagpoints + 1
-                    newflag%iarray3(m1:m2,n1:n2,o1:o2) = 1
-                endif
-            enddo
-            enddo
-            enddo
-        endif
-!
-    else
-!
-        flagpoints = 1
-        if ( Agrif_probdim == 1 ) newflag%iarray1 = g % tabpoint1D
-        if ( Agrif_probdim == 2 ) newflag%iarray2 = g % tabpoint2D
-        if ( Agrif_probdim == 3 ) newflag%iarray3 = g % tabpoint3D
-!
-    endif
-!
-    if (flagpoints == 0) then
-        if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1)
-        if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2)
-        if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3)
-        return
-    endif
-!
-    do i = 1 , Agrif_probdim
-        newrect % imin(i) = 1
-        newrect % imax(i) = sx(i)
-    enddo
-!
-    call Agrif_Clusternd(newflag,parent_rect%childgrids,newrect)
-!
-    if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1)
-    if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2)
-    if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_ClusterGridnD
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_ClusternD
-!
-!> Clustering on the grid pointed by oldB.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Clusternd ( flag, boxlib, oldB )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Variable_i)            :: flag
-    TYPE(Agrif_LRectangle), pointer :: boxlib
-    TYPE(Agrif_Rectangle)           :: oldB
-!
-    TYPE(Agrif_LRectangle),pointer :: tempbox,parcbox,parcbox2
-    TYPE(Agrif_Rectangle) :: newB,newB2
-    INTEGER :: i,j,k
-    INTEGER, DIMENSION(:), allocatable :: i_sig, j_sig, k_sig
-    INTEGER, DIMENSION(3) :: ipu,ipl
-    INTEGER, DIMENSION(3) :: istr,islice
-    REAL :: cureff, neweff
-    INTEGER :: ValMax,ValSum,TailleTab
-    INTEGER :: nbpoints,nbpointsflag
-    LOGICAL :: test
-!
-                              allocate( i_sig(oldB%imin(1):oldB%imax(1)) )
-    if ( Agrif_probdim >= 2 ) allocate( j_sig(oldB%imin(2):oldB%imax(2)) )
-    if ( Agrif_probdim == 3 ) allocate( k_sig(oldB%imin(3):oldB%imax(3)) )
-!
-    test = .FALSE.
-    do i = 1,Agrif_probdim
-        test = test .OR. ( (oldB%imax(i)-oldB%imin(i)+1) <  Agrif_Minwidth)
-    enddo
-    if ( test ) return
-!
-    if ( Agrif_probdim == 1 ) i_sig = flag%iarray1
-    if ( Agrif_probdim == 2 ) then
-        do i = oldB%imin(1),oldB%imax(1)
-            i_sig(i) = SUM(flag%iarray2(i, oldB%imin(2):oldB%imax(2)))
-        enddo
-        do j = oldB%imin(2),oldB%imax(2)
-            j_sig(j) = SUM(flag%iarray2(oldB%imin(1):oldB%imax(1),j))
-        enddo
-    endif
-    if ( Agrif_probdim == 3 ) then
-        do i = oldB%imin(1),oldB%imax(1)
-            i_sig(i) = SUM(flag%iarray3(i,oldB%imin(2):oldB%imax(2),    &
-                                          oldB%imin(3):oldB%imax(3)))
-        enddo
-        do j = oldB%imin(2),oldB%imax(2)
-            j_sig(j) = SUM(flag%iarray3(  oldB%imin(1):oldB%imax(1), j, &
-                                          oldB%imin(3):oldB%imax(3)))
-        enddo
-        do k = oldB%imin(3),oldB%imax(3)
-            k_sig(k) = SUM(flag%iarray3(  oldB%imin(1):oldB%imax(1),    &
-                                          oldB%imin(2):oldB%imax(2), k) )
-        enddo
-    endif
-!
-    do i = 1,Agrif_probdim
-        ipl(i) = oldB%imin(i)
-        ipu(i) = oldB%imax(i)
-    enddo
-!
-                              call Agrif_Clusterprune(i_sig,ipl(1),ipu(1))
-    if ( Agrif_probdim >= 2 ) call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))
-    if ( Agrif_probdim == 3 ) call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))
-!
-    test = .TRUE.
-    do i = 1,Agrif_probdim
-        test = test .AND. (ipl(i) == oldB%imin(i))
-        test = test .AND. (ipu(i) == oldB%imax(i))
-    enddo
-
-    if (.NOT. test) then
-        do i = 1 , Agrif_probdim
-            newB%imin(i) = ipl(i)
-            newB%imax(i) = ipu(i)
-        enddo
-!
-        if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
-        if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),    &
-                                                              newB%imin(2):newB%imax(2)))
-        if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),    &
-                                                              newB%imin(2):newB%imax(2),    &
-                                                              newB%imin(3):newB%imax(3)))
-!
-        if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
-        if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
-                                              (newB%imax(2)-newB%imin(2)+1)
-        if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
-                                              (newB%imax(2)-newB%imin(2)+1) * &
-                                              (newB%imax(3)-newB%imin(3)+1)
-        neweff = REAL(nbpoints) / TailleTab
-!
-        if (nbpoints > 0) then
-!
-            if ((neweff > Agrif_efficiency)) then
-                call Agrif_Add_Rectangle(newB,boxlib)
-                return
-            else
-!
-                tempbox => boxlib
-                newB2 = newB
-                call Agrif_Clusternd(flag,boxlib,newB)
-!
-!               Compute new efficiency
-                cureff = neweff
-                parcbox2 => boxlib
-                nbpoints = 0
-                nbpointsflag = 0
-!
-                do while (associated(parcbox2))
-                    if (associated(parcbox2,tempbox)) exit
-                    newB = parcbox2%r
-!
-                    if ( Agrif_probdim == 1 ) Valsum = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
-                    if ( Agrif_probdim == 2 ) Valsum = SUM(flag%iarray2(newB%imin(1):newB%imax(1), &
-                                                                        newB%imin(2):newB%imax(2)))
-                    if ( Agrif_probdim == 3 ) Valsum = SUM(flag%iarray3(newB%imin(1):newB%imax(1), &
-                                                                        newB%imin(2):newB%imax(2), &
-                                                                        newB%imin(3):newB%imax(3)))
-                    nbpointsflag = nbpointsflag + ValSum
-!
-                    if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
-                    if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
-                                                          (newB%imax(2)-newB%imin(2)+1)
-                    if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
-                                                          (newB%imax(2)-newB%imin(2)+1) * &
-                                                          (newB%imax(3)-newB%imin(3)+1)
-                    nbpoints = nbpoints + TailleTab
-                    parcbox2 => parcbox2%next
-                enddo
-!
-! coefficient 1.05 avant 1.15 possibilite de laisser choix a l utilisateur
-                if ( REAL(nbpointsflag)/REAL(nbpoints) < (1.0001*cureff)) then
-                    parcbox2 => boxlib
-                    do while (associated(parcbox2))
-                        if (associated(parcbox2,tempbox)) exit
-                        deallocate(parcbox2%r)
-                        parcbox2 => parcbox2%next
-                    enddo
-                    boxlib => tempbox
-                    call Agrif_Add_Rectangle(newB2,boxlib)
-                    return
-                endif
-            endif
-        endif
-        return
-    endif
-!
-    do i = 1,Agrif_Probdim
-        istr(i) = oldB%imax(i)
-        islice(i) = oldB%imin(i)
-    enddo
-!
-                              call Agrif_Clusterslice(i_sig,islice(1),istr(1))
-    if ( Agrif_probdim >= 2 ) call Agrif_Clusterslice(j_sig,islice(2),istr(2))
-    if ( Agrif_probdim == 3 ) call Agrif_Clusterslice(k_sig,islice(3),istr(3))
-!
-    ValSum = 0
-    do i = 1,Agrif_Probdim
-        Valsum = valSum + islice(i)
-    enddo
-!
-    if ( Valsum == -Agrif_Probdim ) then
-        call Agrif_Add_Rectangle(oldB,boxlib)
-        return
-    endif
-!
-    nullify(tempbox)
-    tempbox => boxlib
-    if ( Agrif_probdim == 1 ) cureff = (oldB%imax(1)-oldB%imin(1)+1)
-    if ( Agrif_probdim == 2 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * &
-                                       (oldB%imax(2)-oldB%imin(2)+1)
-    if ( Agrif_probdim == 3 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * &
-                                       (oldB%imax(2)-oldB%imin(2)+1) * &
-                                       (oldB%imax(3)-oldB%imin(3)+1)
-    nullify(parcbox)
-!
-    do i = 1,Agrif_Probdim
-        newB%imax(i) = oldB%imax(i)
-        newB%imin(i) = oldB%imin(i)
-    enddo
-!
-    ValMax = 0
-    do i = 1 , Agrif_Probdim
-        ValMax = Max(ValMax,istr(i))
-    enddo
-!
-    if (istr(1) == ValMax ) then
-        newB%imax(1) = islice(1)
-        call Agrif_Add_Rectangle(newB,parcbox)
-        newB%imin(1) = islice(1)+1
-        newB%imax(1) = oldB%imax(1)
-        call Agrif_Add_Rectangle(newB,parcbox)
-    else if ( Agrif_probdim >= 2 ) then
-        if (istr(2) == ValMax ) then
-            newB%imax(2) = islice(2)
-            call Agrif_Add_Rectangle(newB,parcbox)
-            newB%imin(2) = islice(2)+1
-            newB%imax(2) = oldB%imax(2)
-            call Agrif_Add_Rectangle(newB,parcbox)
-        else if ( Agrif_probdim == 3 ) then
-            newB%imax(3) = islice(3)
-            call Agrif_Add_Rectangle(newB,parcbox)
-            newB%imin(3) = islice(3)+1
-            newB%imax(3) = oldB%imax(3)
-            call Agrif_Add_Rectangle(newB,parcbox)
-        endif
-    endif
-!
-    do while ( associated(parcbox) )
-        newB = parcbox%r
-!
-        if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
-        if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),    &
-                                                              newB%imin(2):newB%imax(2)))
-        if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),    &
-                                                              newB%imin(2):newB%imax(2),    &
-                                                              newB%imin(3):newB%imax(3)))
-!
-        if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
-        if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
-                                              (newB%imax(2)-newB%imin(2)+1)
-        if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
-                                              (newB%imax(2)-newB%imin(2)+1) * &
-                                              (newB%imax(3)-newB%imin(3)+1)
-        neweff = REAL(nbpoints) / TailleTab
-!
-        if ( nbpoints > 0 ) then
-!
-            if ( (neweff > Agrif_efficiency)) then
-                call Agrif_Add_Rectangle(newB,boxlib)
-            else
-                tempbox => boxlib
-                newB2 = newB
-                call Agrif_Clusternd(flag,boxlib,newB)
-!
-!               Compute new efficiency
-                cureff = neweff
-                parcbox2 => boxlib
-                nbpoints = 0
-                nbpointsflag = 0
-!
-                do while (associated(parcbox2))
-                    if (associated(parcbox2,tempbox)) exit
-                    newB = parcbox2%r
-!
-                    if ( Agrif_probdim == 1 ) ValSum = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
-                    if ( Agrif_probdim == 2 ) ValSum = SUM(flag%iarray2(newB%imin(1):newB%imax(1),  &
-                                                                        newB%imin(2):newB%imax(2)))
-                    if ( Agrif_probdim == 3 ) ValSum = SUM(flag%iarray3(newB%imin(1):newB%imax(1),  &
-                                                                        newB%imin(2):newB%imax(2),  &
-                                                                        newB%imin(3):newB%imax(3)))
-                    nbpointsflag = nbpointsflag + ValSum
-!
-                    if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
-                    if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
-                                                          (newB%imax(2)-newB%imin(2)+1)
-                    if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
-                                                          (newB%imax(2)-newB%imin(2)+1) * &
-                                                          (newB%imax(3)-newB%imin(3)+1)
-                    nbpoints = nbpoints + TailleTab
-                    parcbox2 => parcbox2%next
-                enddo
-!
-                if  ( REAL(nbpointsflag)/REAL(nbpoints) < (1.15*cureff)) then
-                    parcbox2 => boxlib
-                    do while (associated(parcbox2))
-                        if (associated(parcbox2,tempbox)) exit
-                        deallocate(parcbox2%r)
-                        parcbox2 => parcbox2%next
-                    enddo
-                    boxlib => tempbox
-                    call Agrif_Add_Rectangle(newB2,boxlib)
-                endif
-            endif
-        endif
-        parcbox => parcbox%next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Clusternd
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Clusterslice
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Clusterslice ( sig, slice, str )
-!---------------------------------------------------------------------------------------------------
-    INTEGER,                       intent(inout) :: slice
-    INTEGER,                       intent(inout) :: str
-    INTEGER, DIMENSION(slice:str), intent(in)    :: sig
-!
-    INTEGER                         :: ideb, ifin
-    INTEGER                         :: i, t, a, di, ts
-    INTEGER, DIMENSION(slice:str)   :: lap
-!
-    ideb = slice
-    ifin = str
-!
-    if (SIZE(sig) <= 2*Agrif_Minwidth) then
-        str = -1
-        slice = -1
-        return
-    endif
-!
-    t = -1
-    a = -1
-!
-    do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
-        if (sig(i) == 0) then
-            if ((i-ideb) < (ifin-i)) then
-                di = i - ideb
-            else
-                di = ifin - i
-            endif
-!
-            if (di > t) then
-                a = i
-                t = di
-            endif
-        endif
-    enddo
-!
-    if (a /= -1) then
-        slice = a
-        str = t
-        return
-    endif
-!
-    t = -1
-    a = -1
-!
-    do i = ideb+1,ifin-1
-        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i)
-    enddo
-!
-    do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
-        if ((lap(i+1)*lap(i)) <= 0) then
-            ts = ABS(lap(i+1) - lap(i))
-            if (ts > t) then
-                t = ts
-                a = i
-            endif
-       endif
-    enddo
-!
-    if (a == (ideb + Agrif_Minwidth - 1)) then
-        a = -1
-        t = -1
-    endif
-!
-    slice = a
-    str = t
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Clusterslice
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Clusterprune
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Clusterprune ( sig, pl, pu )
-!---------------------------------------------------------------------------------------------------
-    INTEGER,                   intent(inout)    :: pl, pu
-    INTEGER, DIMENSION(pl:pu), intent(in)       :: sig
-!
-    INTEGER :: ideb, ifin
-    INTEGER :: diff, addl, addu, udist, ldist
-!
-    ideb = pl
-    ifin = pu
-!
-    if (SIZE(sig) <= Agrif_Minwidth) return
-!
-    do while ((sig(pl) == 0) .AND. (pl < ifin))
-        pl = pl + 1
-    enddo
-!
-    do while ((sig(pu) == 0) .AND. (pu > ideb))
-        pu = pu - 1
-    enddo
-!
-    if ( (pu-pl) < Agrif_Minwidth ) then
-        diff = Agrif_Minwidth - (pu - pl + 1)
-        udist = ifin - pu
-        ldist = pl - ideb
-        addl = diff / 2
-        addu = diff - addl
-        if (addu > udist) then
-            addu = udist
-            addl = diff - addu
-        endif
-!
-        if (addl > ldist) then
-            addl = ldist
-            addu = diff - addl
-        endif
-!
-        pu = pu + addu
-        pl = pl - addl
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Clusterprune
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Add_Rectangle
-!
-!> Adds the Agrif_Rectangle R in a list managed by LR.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Add_Rectangle ( R, LR )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Rectangle)           :: R
-    TYPE(Agrif_LRectangle), pointer :: LR
-!
-    TYPE(Agrif_LRectangle), pointer :: newrect
-!
-    integer                         :: i
-!
-    allocate(newrect)
-    allocate(newrect % r)
-!
-    newrect % r = R
-!
-    do i = 1,Agrif_Probdim
-        newrect % r % spaceref(i) = Agrif_Coeffref(i)
-        newrect % r % timeref(i)  = Agrif_Coeffreft(i)
-    enddo
-!
-    newrect % r % number = -1
-    newrect % next => LR
-    LR => newrect
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Add_Rectangle
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Copy_Rectangle
-!
-!> Creates and returns a copy of Agrif_Rectangle R.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Copy_Rectangle ( R, expand ) result( copy )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Rectangle), pointer, intent(in) :: R
-    integer, optional,              intent(in) :: expand
-!
-    TYPE(Agrif_Rectangle), pointer :: copy
-!
-    allocate(copy)
-!
-    copy = R
-    if ( present(expand) ) then
-        copy % imin = copy % imin - expand
-        copy % imax = copy % imax + expand
-    endif
-    copy % childgrids => R % childgrids
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Copy_Rectangle
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Read_Fix_Grd
-!
-!> Creates the grid hierarchy from the reading of the AGRIF_FixedGrids.in file.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Read_Fix_Grd ( parent_rect, j, nunit )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Rectangle), pointer   :: parent_rect !< Pointer on the first grid of the grid hierarchy
-    INTEGER                          :: j          !< Number of the new grid
-    INTEGER                          :: nunit      !< unit associated with file
-!
-    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
-    TYPE(Agrif_LRectangle), pointer  :: parcours   ! Pointer for the recursive procedure
-    TYPE(Agrif_LRectangle), pointer  :: newlrect
-    TYPE(Agrif_LRectangle), pointer  :: end_list
-    INTEGER                          :: i,n        ! for each child grid
-    INTEGER                          :: nb_grids   ! Number of child grids
-!
-!   Reading of the number of child grids
-    read(nunit,*,end=99) nb_grids
-!
-    allocate(end_list)
-!
-    parent_rect % childgrids => end_list
-!
-!   Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
-!        time refinement factors for each child grid.
-!   Creation and addition of the new grid to the grid hierarchy.
-!
-    do n = 1,nb_grids
-!
-        allocate(newlrect)
-        newrect % number = j   ! Number of the grid
-!
-        if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
-            if (Agrif_Probdim == 3) then
-                read(nunit,*) newrect % imin(1), newrect % imax(1), &
-                              newrect % imin(2), newrect % imax(2), &
-                              newrect % imin(3), newrect % imax(3), &
-                              newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), &
-                              newrect % timeref(1), newrect % timeref(2), newrect % timeref(3)
-            elseif (Agrif_Probdim == 2) then
-                read(nunit,*) newrect % imin(1), newrect % imax(1), &
-                              newrect % imin(2), newrect % imax(2), &
-                              newrect % spaceref(1), newrect % spaceref(2), &
-                              newrect % timeref(1),  newrect % timeref(2)
-            elseif (Agrif_Probdim == 1) then
-                read(nunit,*) newrect % imin(1), newrect % imax(1), &
-                              newrect % spaceref(1), &
-                              newrect % timeref(1)
-            endif
-        else
-            if (Agrif_Probdim == 3) then
-                read(nunit,*) newrect % imin(1), newrect % imax(1), &
-                              newrect % imin(2), newrect % imax(2), &
-                              newrect % imin(3), newrect % imax(3), &
-                              newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), &
-                              newrect % timeref(1)
-            elseif (Agrif_Probdim == 2) then
-                read(nunit,*) newrect % imin(1), newrect % imax(1), &
-                              newrect % imin(2), newrect % imax(2), &
-                              newrect % spaceref(1), newrect % spaceref(2), &
-                              newrect % timeref(1)
-            elseif (Agrif_Probdim == 1) then
-                read(nunit,*) newrect % imin(1), newrect % imax(1), &
-                              newrect % spaceref(1), &
-                              newrect % timeref(1)
-            endif
-!
-            if ( Agrif_probdim >= 2 ) then
-                do i = 2,Agrif_probdim
-                    newrect % timeref(i) = newrect % timeref(1)
-                enddo
-            endif
-!
-        endif
-!
-!       Addition to the grid hierarchy
-!
-        j = j + 1
-        allocate(newlrect%r)
-        newlrect % r = newrect
-        end_list % next => newlrect
-        end_list => end_list % next
-!
-    enddo
-!
-    parent_rect % childgrids => parent_rect % childgrids % next
-    parcours => parent_rect % childgrids
-!
-!   recursive operation to create the grid hierarchy branch by branch
-!
-    do while ( associated(parcours) )
-        call Agrif_Read_Fix_Grd(parcours % r, j, nunit)
-        parcours => parcours % next
-    enddo
-99  continue
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Read_Fix_Grd
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Create_Grids
-!
-!> Creates the grid hierarchy (g) from the one created with the #Agrif_Read_Fix_Grd or
-!! #Agrif_Cluster_All procedures (parent_rect).
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Create_Grids ( parent_grid, parent_rect )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Grid)     , pointer  :: parent_grid  !< Pointer on the root coarse grid
-    TYPE(Agrif_Rectangle), pointer  :: parent_rect  !< Pointer on the root coarse grid of the grid hierarchy
-                                                    !!   created with the #Agrif_Read_Fix_Grd subroutine
-!
-    TYPE(Agrif_Grid)      , pointer :: child_grid   ! Newly created child grid
-    TYPE(Agrif_PGrid)     , pointer :: child_grid_p
-    TYPE(Agrif_LRectangle), pointer :: child_rect_p
-    type(Agrif_Rectangle),  pointer :: child_rect
-!
-    INTEGER                         :: i
-    INTEGER, save                   :: moving_grid_id = 0
-!
-    child_rect_p => parent_rect % childgrids
-!
-!   Creation of the grid hierarchy from the one created by using the Agrif_Read_Fix_Grd subroutine
-!
-    do while ( associated(child_rect_p) )
-!
-        child_rect => child_rect_p % r
-!
-        allocate(child_grid)
-!
-!       Pointer on the parent grid
-        child_grid % parent => parent_grid
-        child_grid % rect_in_parent => Agrif_Copy_Rectangle(child_rect_p % r, expand=Agrif_Extra_Boundary_Cells)
-!
-        moving_grid_id = moving_grid_id+1
-        child_grid % grid_id = moving_grid_id
-!
-        do i = 1,Agrif_Probdim
-            child_grid % spaceref(i) = child_rect % spaceref(i)
-            child_grid % timeref(i)  = child_rect % timeref(i)
-            child_grid % nb(i) = (child_rect % imax(i) - child_rect % imin(i)) * child_rect % spaceref(i)
-            child_grid % ix(i) =  child_rect % imin(i)
-            child_grid % Agrif_dt(i) = parent_grid % Agrif_dt(i) / REAL(child_grid % timeref(i))
-            child_grid % Agrif_dx(i) = parent_grid % Agrif_dx(i) / REAL(child_grid % spaceref(i))
-            child_grid % Agrif_x(i)  = parent_grid % Agrif_x(i) + &
-                                            (child_rect % imin(i) - 1) * parent_grid % Agrif_dx(i)
-        enddo
-!
-!       Size of the grid in terms of cpu cost (nx*ny*timeref)
-        child_grid % size = product( child_grid % nb(1:Agrif_Probdim) ) * child_grid % timeref(1)
-!
-!       Level of the current grid
-        child_grid % level = child_grid % parent % level + 1
-        if (child_grid % level > Agrif_MaxLevelLoc) then
-          Agrif_MaxLevelLoc = child_grid%level
-        endif
-!
-!       Number of the grid pointed by child_grid
-        child_grid % fixedrank = child_rect % number
-!
-!       Grid pointed by child_grid is a fixed grid
-        child_grid % fixed = ( child_grid % fixedrank > 0 )
-!
-!       Update the total number of fixed grids
-        if (child_grid % fixed) then
-            Agrif_nbfixedgrids = Agrif_nbfixedgrids + 1
-        endif
-!
-!       Initialize integration counter
-        child_grid % ngridstep = 0
-!
-!       Test indicating if the current grid has a common border with the root
-!       coarse grid in the x direction
-        do i = 1 , Agrif_Probdim
-!
-            child_grid % NearRootBorder(i) = (                  &
-                (child_grid % parent % NearRootBorder(i)) .AND. &
-                (child_grid % ix(i) == 1) )
-!
-            child_grid % DistantRootBorder(i) = (                  &
-                (child_grid % parent % DistantRootBorder(i)) .AND. &
-                (child_grid % ix(i) + (child_grid%nb(i)/child_grid%spaceref(i))-1  == child_grid % parent % nb(i)) )
-        enddo
-!
-!       Writing in output files
-        child_grid % oldgrid = .FALSE.
-!
-#if defined AGRIF_MPI
-        child_grid % communicator = parent_grid % communicator
-#endif
-!
-!       Definition of the characteristics of the variable of the grid pointed by child_grid
-        call Agrif_Create_Var(child_grid)
-!
-!       Addition of this grid to the grid hierarchy
-        call Agrif_gl_append( parent_grid % child_list, child_grid )
-!
-        child_rect_p => child_rect_p % next
-!
-    enddo
-!
-!   Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the grid hierarchy
-!
-    child_grid_p => parent_grid % child_list % first
-    child_rect_p => parent_rect % childgrids
-!
-    do while ( associated(child_rect_p) )
-        call Agrif_Create_Grids( child_grid_p % gr, child_rect_p % r )
-        child_grid_p => child_grid_p % next
-        child_rect_p => child_rect_p % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Create_Grids
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Init_Hierarchy
-!
-!> Initializes all the grids except the root coarse grid (this one, pointed by Agrif_Types::Agrif_Mygrid, is
-!! initialized by the subroutine Agrif_Util#Agrif_Init_Grids defined in the module Agrif_Util and
-!! called in the main program).
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Init_Hierarchy ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    use Agrif_seq
-!
-    type(Agrif_Grid), pointer       :: g            !< Pointer on the current grid
-    procedure(init_proc), optional  :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
-!
-    TYPE(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
-    LOGICAL                    :: Init_Hierarchy
-!
-! Initialise the grand mother grid (if any)
-!
-    if ( associated(g, Agrif_Mygrid) .and. agrif_coarse ) then
-        call Agrif_Instance(Agrif_Coarsegrid)
-        call Agrif_Allocation(Agrif_Coarsegrid)
-        call Agrif_initialisations(Agrif_Coarsegrid)
-        call Agrif_InitWorkspace()
-!
-!       Initialization by interpolation (this routine is written by the user)
-        if (present(procname)) Then
-            call procname()
-        else
-            call Agrif_InitValues()
-        endif
-        call Agrif_Instance(Agrif_Mygrid)
-    endif
-
-    parcours => g % child_list % first
-!
-    do while ( associated(parcours) )
-!
-        Init_Hierarchy = .false.
-        if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
-            if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then
-                Init_Hierarchy = .true.
-            endif
-        endif
-!
-        if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true.
-        if (parcours % gr % oldgrid)     Init_Hierarchy = .false.
-!
-        if (Init_Hierarchy) then
-!
-!           Instanciation of the grid pointed by parcours%gr and its variables
-            call Agrif_Instance(parcours % gr)
-!
-!           Allocation of the arrays containing values of the variables of the
-!           grid pointed by parcours%gr
-!
-            call Agrif_Allocation(parcours % gr)
-            call Agrif_initialisations(parcours % gr)
-!
-            if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
-!               Initialization by copy of the grids created by clustering
-                call Agrif_Allocate_Restore(parcours % gr)
-                call Agrif_CopyFromOld_All(parcours % gr, Agrif_oldmygrid)
-            endif
-!
-!           Initialization by interpolation (this routine is written by the user)
-            call Agrif_InitWorkSpace()
-            if (present(procname)) Then
-                call procname()
-            else
-                call Agrif_InitValues()
-            endif
-!
-            if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
-                call Agrif_Free_Restore(parcours % gr)
-            endif
-!
-        endif
-!
-        parcours => parcours % next
-!
-    enddo
-!
-    parcours => g % child_list % first
-!
-!   recursive operation to initialize all the grids
-    do while ( associated(parcours) )
-        call Agrif_Init_Hierarchy(parcours%gr,procname)
-        parcours => parcours%next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Init_Hierarchy
-!===================================================================================================
-!
-#if defined AGRIF_MPI
-!===================================================================================================
-!  subroutine Agrif_Init_Hierarchy_Parallel_1
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Init_Hierarchy_Parallel_1 ( g )
-!---------------------------------------------------------------------------------------------------
-    use Agrif_seq
-!
-    type(Agrif_Grid), pointer       :: g            !< Pointer on the current grid
-!
-    TYPE(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
-    LOGICAL                    :: Init_Hierarchy
-!
-    parcours => g % child_list % first
-!
-    do while ( associated(parcours) )
-!
-        Init_Hierarchy = .false.
-        if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
-            if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then
-                Init_Hierarchy = .true.
-            endif
-        endif
-!
-        if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true.
-        if (parcours % gr % oldgrid)     Init_Hierarchy = .false.
-!
-        if (Init_Hierarchy) then
-!
-!           Instanciation of the grid pointed by parcours%gr and its variables
-            call Agrif_Instance(parcours % gr)
-!
-!           Allocation of the arrays containing values of the variables of the
-!           grid pointed by parcours%gr
-!
-            call Agrif_Allocation(parcours % gr)
-            call Agrif_initialisations(parcours % gr)
-!
-        endif
-!
-        parcours => parcours % next
-!
-    enddo
-!
-    parcours => g % child_list % first
-!
-!   recursive operation to initialize all the grids
-    do while ( associated(parcours) )
-        call Agrif_Init_Hierarchy_Parallel_1(parcours%gr)
-        parcours => parcours%next
-    enddo
-!
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Init_Hierarchy_Parallel_1
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Init_Hierarchy_Parallel_2
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Init_Hierarchy_Parallel_2 ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    use Agrif_seq
-!
-    type(Agrif_Grid),     pointer   :: g            !< Pointer on the current grid
-    procedure(init_proc), optional  :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
-!
-    type(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
-    integer :: is
-!
-    call Agrif_Instance(g)
-    call Agrif_seq_init_sequences( g )
-!
-    if ( .not. associated(g % child_seq) ) return
-!
-    do is = 1, g % child_seq % nb_seqs
-!
-        parcours => Agrif_seq_select_child(g,is)
-!
-!     Instanciation of the variables of the current grid
-        call Agrif_Instance(parcours % gr)
-!
-!     Initialization by interpolation (this routine is written by the user)
-        if (present(procname)) Then
-            call procname()
-        else
-            call Agrif_InitValues()
-        endif
-!
-        call Agrif_Init_ProcList(parcours % gr % proc_def_list, &
-                                 parcours % gr % proc_def_in_parent_list % nitems)
-!
-        call Agrif_Init_Hierarchy_Parallel_2(parcours%gr,procname)
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Init_Hierarchy_Parallel_2
-!===================================================================================================
-#endif
-!
-!===================================================================================================
-!  subroutine Agrif_Allocate_Restore
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Allocate_Restore ( Agrif_Gr )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Grid), pointer  :: Agrif_Gr   !< Pointer on the root coarse grid
-!
-    integer :: i
-!
-    do i = 1,Agrif_NbVariables(0)
-!
-        if ( Agrif_Mygrid%tabvars(i) % restore ) then
-            if ( Agrif_Gr%tabvars(i) % nbdim == 1 ) then
-                allocate( Agrif_Gr%tabvars(i)%Restore1D( &
-                    lbound(Agrif_Gr%tabvars(i)%array1,1):&
-                    ubound(Agrif_Gr%tabvars(i)%array1,1)))
-                Agrif_Gr%tabvars(i)%Restore1D = 0
-            endif
-            if ( Agrif_Gr%tabvars(i) % nbdim == 2 ) then
-                allocate( Agrif_Gr%tabvars(i)%Restore2D( &
-                    lbound(Agrif_Gr%tabvars(i)%array2,1):&
-                    ubound(Agrif_Gr%tabvars(i)%array2,1),&
-                    lbound(Agrif_Gr%tabvars(i)%array2,2):&
-                    ubound(Agrif_Gr%tabvars(i)%array2,2)))
-                Agrif_Gr%tabvars(i)%Restore2D = 0
-            endif
-            if ( Agrif_Mygrid%tabvars(i) % nbdim == 3 ) then
-                allocate( Agrif_Gr%tabvars(i)%Restore3D( &
-                    lbound(Agrif_Gr%tabvars(i)%array3,1):&
-                    ubound(Agrif_Gr%tabvars(i)%array3,1),&
-                    lbound(Agrif_Gr%tabvars(i)%array3,2):&
-                    ubound(Agrif_Gr%tabvars(i)%array3,2),&
-                    lbound(Agrif_Gr%tabvars(i)%array3,3):&
-                    ubound(Agrif_Gr%tabvars(i)%array3,3)))
-                Agrif_Gr%tabvars(i)%Restore3D = 0
-            endif
-        endif
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Allocate_Restore
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Free_Restore
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Free_Restore ( Agrif_Gr )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Grid), pointer  :: Agrif_Gr   !< Pointer on the root coarse grid
-!
-    TYPE(Agrif_Variable), pointer :: var
-    integer                       :: i
-!
-    do i = 1,Agrif_NbVariables(0)
-!
-        if ( Agrif_Mygrid % tabvars(i) % restore ) then
-!
-            var = Agrif_Gr % tabvars(i)
-!
-            if (associated(var%Restore1D)) deallocate(var%Restore1D)
-            if (associated(var%Restore2D)) deallocate(var%Restore2D)
-            if (associated(var%Restore3D)) deallocate(var%Restore3D)
-            if (associated(var%Restore4D)) deallocate(var%Restore4D)
-            if (associated(var%Restore5D)) deallocate(var%Restore5D)
-            if (associated(var%Restore6D)) deallocate(var%Restore6D)
-!
-        endif
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Free_Restore
-!===================================================================================================
-!
-end module Agrif_Clustering
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 10251)
@@ -0,0 +1,990 @@
+!
+! $Id: modcurgridfunctions.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_CurgridFunctions      
+C      
+      Module Agrif_CurgridFunctions    
+C  
+CCC   Description:
+CCC   Module to define some procedures concerning the current grid
+C
+C     Modules used: 
+C
+      Use Agrif_Init
+C
+      IMPLICIT NONE
+C
+C
+      Contains
+C     Define procedures contained in this module
+C
+C     **************************************************************************
+CCC   Function Agrif_Rhot
+C     **************************************************************************
+C
+      Function Agrif_Rhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      REAL :: Agrif_Rhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % timeref(iii))
+      enddo
+C
+      Agrif_Rhot = float(res)
+C
+C
+      End function Agrif_rhot
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_IRhot
+C     **************************************************************************
+C
+      Function Agrif_IRhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      INTEGER :: Agrif_IRhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % timeref(iii))
+      enddo
+C
+      Agrif_IRhot = res
+C
+C
+      End function Agrif_IRhot
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhot
+C     **************************************************************************
+C
+      Function Agrif_Parent_Rhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the parent grid of the 
+CCC   current grid.
+C
+C     Declarations:
+C  
+      
+C
+      REAL :: Agrif_Parent_Rhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
+      enddo
+C
+      Agrif_Parent_Rhot = float(res)
+C
+C
+      End function Agrif_Parent_Rhot      
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_IRhot
+C     **************************************************************************
+C
+      Function Agrif_Parent_IRhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the parent grid of the 
+CCC   current grid.
+C
+C     Declarations:
+C  
+      
+C
+      INTEGER :: Agrif_Parent_IRhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
+      enddo
+C
+      Agrif_Parent_IRhot = res
+C
+C
+      End function Agrif_Parent_IRhot      
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Nbstepint
+C     **************************************************************************
+C
+      Function Agrif_Nbstepint()
+C  
+CCC   Description:
+CCC   Function for the calculation of the coefficients used for the time 
+CCC   interpolation (module Agrif_Boundary).
+C
+C     Declarations:
+C  
+      
+C            
+      INTEGER :: Agrif_nbstepint  ! result
+C
+C
+      Agrif_nbstepint = mod(AGRIF_CURGRID % ngridstep,
+     &                      int(AGRIF_rhot()))
+C
+C
+      End function Agrif_Nbstepint
+C
+C
+C
+CC    **************************************************************************
+CCC   Function Agrif_Parent_Nbstepint
+C     **************************************************************************
+C
+      Function Agrif_Parent_Nbstepint()
+C  
+CCC   Description:
+CCC   Function for the calculation of the coefficients used for the time 
+CCC   interpolation (module Agrif_Boundary).
+C
+C     Declarations:
+C  
+      
+C            
+      INTEGER :: Agrif_Parent_Nbstepint  ! result
+C
+C
+      Agrif_Parent_Nbstepint = mod(AGRIF_CURGRID % parent % ngridstep, 
+     &                             int(AGRIF_Parent_Rhot()))
+C
+C
+      End function Agrif_Parent_Nbstepint
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderX
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderX()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the x direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.   
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(1) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderX 
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderX
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderX()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the x direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(1) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderX                 
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderY
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderY()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the y direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(2) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderY
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderY
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderY()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the y direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(2) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderY      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderZ
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderZ()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the z direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(3) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderZ
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderZ
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderZ()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the z direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(3) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderZ
+C 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Nb_Step
+C     ************************************************************************** 
+C 
+      Function AGRIF_Parent_Nb_Step() 
+C  
+CCC   Description:
+CCC   Function returning the number of time steps of the parent grid of the
+CCC   current grid.
+C
+C     Declarations:
+C    
+      
+C
+      INTEGER :: AGRIF_Parent_Nb_Step ! Result 
+C
+C
+      if (Agrif_Root()) then  
+C     
+          Agrif_Parent_Nb_Step = -1 
+C       
+        else
+C       
+          Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
+C     
+      endif
+C
+C     
+      End function Agrif_Parent_Nb_Step    
+C 
+C
+C 
+C     **************************************************************************
+CCC   Function Agrif_Root
+C     **************************************************************************
+C
+      Function Agrif_Root()
+C     
+CCC   Description:
+CCC   Function indicating if the current grid is or not the root grid.
+C
+C     Declarations:
+C
+      
+C
+      LOGICAL :: Agrif_Root   ! Result
+C    
+C
+      if (AGRIF_CURGRID % fixedrank .EQ. 0) then
+C          
+          Agrif_Root = .TRUE.
+C    
+        else
+C    
+          Agrif_Root = .FALSE.
+C     
+      endif
+C
+C    
+      End function Agrif_Root
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Root
+C     **************************************************************************
+C
+      Function Agrif_Parent_Root()
+C     
+CCC   Description:
+CCC   Function indicating if the parent grid of the current grid is or not the 
+CCC   root grid.
+C
+C     Declarations:
+C
+      
+C
+      LOGICAL :: Agrif_Parent_Root   ! Result
+C    
+C
+      if (AGRIF_CURGRID % parent % fixedrank .EQ. 0) then
+C          
+          Agrif_Parent_Root = .TRUE.
+C    
+        else
+C    
+          Agrif_Parent_Root = .FALSE.
+C     
+      endif
+C
+C    
+      End function Agrif_Parent_Root     
+C 
+C
+C 
+C     **************************************************************************
+CCC   Function Agrif_Fixed
+C     **************************************************************************
+C 
+      Function Agrif_Fixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      INTEGER Agrif_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % fixed) then
+C     
+          Agrif_Fixed = Agrif_Curgrid % fixedrank 
+C
+        else
+C     
+         Agrif_Fixed = -1
+C        
+      endif
+C
+C     
+      End function Agrif_Fixed 
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Parent_Fixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the parent grid of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      INTEGER Agrif_Parent_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % parent % fixed) then
+C     
+          Agrif_Parent_Fixed = AGRIF_CURGRID % parent % fixedrank 
+C
+        else
+C     
+         Agrif_Parent_Fixed = 0
+C        
+      endif
+C
+C     
+      End function Agrif_Parent_Fixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Is_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Is_Fixed()
+C  
+CCC   Description:
+CCC   Function returning true if the current grid is fixed.
+C
+C     Declarations:
+C   
+      
+C
+      LOGICAL Agrif_Is_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % fixed) then
+C     
+          Agrif_Is_Fixed = .true.
+C
+        else
+C     
+          Agrif_Is_Fixed = .false.
+C        
+      endif
+C
+C     
+      End function Agrif_Is_Fixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Is_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Parent_Is_Fixed()
+C  
+CCC   Description:
+CCC   Function returning true if the parent grid of the current grid is fixed.
+C
+C     Declarations:
+C   
+      
+C
+      LOGICAL Agrif_Parent_Is_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % parent % fixed) then
+C     
+          Agrif_Parent_Is_Fixed = .true.
+C
+        else
+C     
+          Agrif_Parent_Is_Fixed = .false.
+C        
+      endif
+C
+C     
+      End function Agrif_Parent_Is_Fixed            
+C
+C 
+C
+C     **************************************************************************
+CCC   Function AGRIF_CFixed
+C     **************************************************************************
+ 
+            Function AGRIF_CFixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      CHARACTER(3) AGRIF_CFixed   ! Result 
+C
+C     Local variables      
+      CHARACTER(3) cfixed
+      INTEGER fixed
+C 
+C
+      fixed = Agrif_Fixed()
+C      
+      if(fixed.NE.-1) then
+C
+           if (fixed .LE. 9) then
+C
+               write(cfixed,'(i1)')fixed
+C 
+           else
+C   
+               write(cfixed,'(i2)')fixed
+C      
+           endif
+C
+           AGrif_Cfixed=cfixed
+C      
+      else
+C
+      print*,'Call to AGRIF_CFixed() on a moving grid'
+      stop
+C
+      endif     
+
+      End function AGRIF_CFixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function AGRIF_Parent_CFixed
+C     **************************************************************************
+ 
+      Function AGRIF_Parent_CFixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the parent grid of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      CHARACTER(3) AGRIF_Parent_CFixed   ! Result 
+C
+C     Local variables      
+      CHARACTER(3) cfixed
+      INTEGER fixed
+C 
+C
+      fixed = Agrif_Parent_Fixed()
+C      
+      if(fixed.NE.-1) then
+C
+          if (fixed .LE. 9) then
+C
+              write(cfixed,'(i1)')fixed
+C      
+          else
+C        
+              write(cfixed,'(i2)')fixed
+C      
+          endif
+C
+          AGrif_Parent_Cfixed=cfixed
+C
+      else
+C
+      print*,'Illegal call to AGRIF_Parent_CFixed()'
+      stop     
+C
+      endif
+
+      End function AGRIF_Parent_CFixed      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ChildGrid_to_ParentGrid
+C     **************************************************************************
+C
+      Subroutine Agrif_ChildGrid_to_ParentGrid()
+C  
+CCC   Description:
+CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the parent
+CCC   grid of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      
+      Agrif_Curgrid%Parent%save_grid => Agrif_Curgrid
+C
+      Call Agrif_Instance(Agrif_Curgrid%parent)            
+C
+C
+      End Subroutine Agrif_ChildGrid_to_ParentGrid
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ParentGrid_to_ChildGrid
+C     **************************************************************************
+C
+      Subroutine Agrif_ParentGrid_to_ChildGrid()
+C  
+CCC   Description:
+CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the child 
+CCC   grid after having called the Agrif_ChildGrid_to_ParentGrid subroutine.
+C
+C     Declarations:
+C  
+      
+C
+C
+      Call Agrif_Instance(Agrif_Curgrid%save_grid)
+C
+C
+      End Subroutine Agrif_ParentGrid_to_ChildGrid
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Get_Unit
+C     **************************************************************************
+C
+      Function Agrif_Get_Unit()
+
+CCC   Description : return a unit not connected to any file
+C
+C     Declarations
+C
+      
+C
+      INTEGER Agrif_Get_Unit
+C
+C     Local scalars
+      INTEGER n
+      LOGICAL op
+C
+      INTEGER :: nunit
+      INTEGER :: iii,out,iiimax
+      Logical :: BEXIST
+      INTEGER,DIMENSION(1:1000) :: ForbiddenUnit
+C
+C
+C     Load forbidden Unit if the file Agrif_forbidenUnit exist
+C      
+
+      INQUIRE(FILE='Agrif_forbiddenUnit.txt',EXIST=BEXIST)
+      If (.not. BEXIST) Then
+c          File Agrif_forbiddenUnit.txt not found
+      Else
+           nunit = 777
+           open(nunit,file='Agrif_forbiddenUnit.txt',form='formatted',
+     &          status="old")
+              iii = 1
+              do while ( .TRUE. )
+                 read(nunit,*,END = 99) ForbiddenUnit(iii)
+                 iii = iii + 1
+              enddo
+   99         CONTINUE
+              iiimax = iii
+           close(nunit)
+      endif     
+C 
+      do n = 7,1000
+C 
+        Inquire(Unit=n,Opened=op)
+C
+        out = 0
+        if ( BEXIST .AND. .NOT.op) then
+           do iii = 1 , iiimax
+              if ( n .EQ. ForbiddenUnit(iii) ) out = 1
+           enddo
+        endif
+C
+        if (.NOT.op .AND. out .EQ. 0) exit
+C      
+      enddo
+C
+      Agrif_Get_Unit=n
+C
+C
+      End Function Agrif_Get_Unit
+      
+      Subroutine Agrif_Set_Efficiency(eff)
+      REAL :: eff
+      
+      IF ((eff.LT.0.).OR.(eff.GT.1)) THEN
+      write(*,*)'Error Efficiency should be between 0 and 1'
+      stop
+      ELSE
+      Agrif_efficiency = eff
+      ENDIF
+      End Subroutine Agrif_Set_Efficiency
+      
+      Subroutine Agrif_Set_Regridding(regfreq)
+      INTEGER :: regfreq
+      
+      IF (regfreq.LT.0) THEN
+      write(*,*)'Regridding frequency should be positive'
+      stop
+      ELSE
+      Agrif_regridding = regfreq
+      ENDIF
+      End Subroutine Agrif_Set_Regridding
+C
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_x
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_x(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(1) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_x
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_y
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_y(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(2) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_y
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_z
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_z(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(3) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_z
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_x
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_x(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(1) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_x
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_y
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_y(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(2) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_y
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_z
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_z(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(3) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_z
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_Minwidth
+C     **************************************************************************
+      subroutine Agrif_Set_Minwidth(coefminwidth)
+
+      integer :: coefminwidth
+
+      if (coefminwidth.LT.0) then
+         write(*,*)'Coefficient of Minwidth should be positive'
+         stop
+      else
+         Agrif_Minwidth = coefminwidth
+      endif
+      end subroutine Agrif_Set_Minwidth
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_Rafmax
+C     **************************************************************************
+      subroutine Agrif_Set_Rafmax(coefrafmax)
+
+      integer :: coefrafmax
+      integer :: i
+      real :: res
+
+      if (coefrafmax.LT.0) then
+         write(*,*)'Coefficient of  should be positive'
+         stop
+      else
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(1))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(1) = 1. / res
+C
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(2))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(2) = 1. / res
+C
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(3))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(3) = 1. / res
+C
+      endif
+      end subroutine Agrif_Set_Rafmax
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Open_File
+C     **************************************************************************
+      subroutine Agrif_Open_File(num_id,name_file)
+
+      integer :: num_id
+      character(*) :: name_file
+
+      num_id = Agrif_Get_Unit()
+      if ( .NOT. Agrif_Root() ) then
+         name_file = TRIM(Agrif_CFixed())//'_'//TRIM(name_file)
+      endif
+
+      end subroutine Agrif_Open_File
+
+C     **************************************************************************
+CCC    subroutine Agrif_Set_MaskMaxSearch
+C     **************************************************************************
+      subroutine Agrif_Set_MaskMaxSearch(mymaxsearch)
+      integer mymaxsearch
+      MaxSearch = mymaxsearch
+      end subroutine Agrif_Set_MaskMaxSearch
+      
+C *****************************************************************
+CCC  subroutine Agrif_Level
+C *****************************************************************
+      Function Agrif_Level()
+      Integer :: Agrif_Level
+     
+      Agrif_Level = Agrif_Curgrid % level
+     
+      End Function Agrif_Level
+      
+C *****************************************************************
+CCC  subroutine Agrif_MaxLevel
+C *****************************************************************
+      Function Agrif_MaxLevel()
+      Integer :: Agrif_MaxLevel
+     
+      Agrif_MaxLevel = Agrif_MaxLevelLoc
+     
+      End Function Agrif_MaxLevel      
+
+      End Module Agrif_CurgridFunctions 
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 10250)
+++ 	(revision )
@@ -1,765 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
-!
-!> Module to define some procedures concerning the current grid
-!
-module Agrif_CurgridFunctions
-!
-    use Agrif_Init
-!
-    implicit none
-!
-contains
-!
-!===================================================================================================
-!  function Agrif_rel_dt
-!
-!> Returns the time step of the current grid, relatively to the root grid (for which dt=1.).
-!---------------------------------------------------------------------------------------------------
-function Agrif_rel_dt ( ) result( rel_dt )
-!---------------------------------------------------------------------------------------------------
-    integer :: i
-    real    :: rel_dt
-!
-    rel_dt = 1.
-!
-    do i = 1,Agrif_Probdim
-        rel_dt = min(rel_dt, Agrif_Curgrid % Agrif_dt(i))
-    enddo
-!---------------------------------------------------------------------------------------------------
-end function Agrif_rel_dt
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_rel_idt
-!
-!> Returns the time refinement factor of the current grid, relatively to the root grid (for which idt=1).
-!---------------------------------------------------------------------------------------------------
-function Agrif_rel_idt ( ) result( rel_idt )
-!---------------------------------------------------------------------------------------------------
-    integer :: rel_idt
-!
-    rel_idt = nint(1./Agrif_rel_dt())
-!---------------------------------------------------------------------------------------------------
-end function Agrif_rel_idt
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_IRhot
-!
-!> Returns the time refinement factor of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_IRhot ( ) result( irhot )
-!---------------------------------------------------------------------------------------------------
-    integer :: i, irhot
-!
-    irhot = 1
-!
-    do i = 1,Agrif_Probdim
-        irhot = max(irhot, Agrif_Curgrid % timeref(i))
-    enddo
-!---------------------------------------------------------------------------------------------------
-end function Agrif_IRhot
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Rhot
-!
-!> Returns the time refinement factor of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Rhot ( ) result( rhot )
-!---------------------------------------------------------------------------------------------------
-    real    :: rhot
-!
-    rhot = float(Agrif_IRhot())
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Rhot
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Parent_IRhot
-!
-!> Returns the time refinement factor of the parent of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Parent_IRhot ( ) result( irhot )
-!---------------------------------------------------------------------------------------------------
-    integer :: i, irhot
-!
-    irhot = 1
-!
-    do i = 1,Agrif_Probdim
-        irhot = max(irhot, Agrif_Curgrid % parent % timeref(i))
-    enddo
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Parent_IRhot
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Parent_Rhot
-!
-!> Returns the time refinement factor of the parent of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Parent_Rhot ( ) result( rhot )
-!---------------------------------------------------------------------------------------------------
-    real :: rhot
-!
-    rhot = float(Agrif_Parent_IRhot())
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Parent_Rhot
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Nbstepint
-!
-!> function for the calculation of the coefficients used for the time interpolation
-!! (module #Agrif_Boundary).
-!---------------------------------------------------------------------------------------------------
-function Agrif_Nbstepint ( )
-!---------------------------------------------------------------------------------------------------
-    integer :: Agrif_nbstepint ! result
-!
-    Agrif_nbstepint = mod(Agrif_Curgrid % ngridstep, Agrif_iRhot())
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Nbstepint
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Parent_Nbstepint
-!
-!> function for the calculation of the coefficients used for the time interpolation
-!! (module #Agrif_Boundary).
-!---------------------------------------------------------------------------------------------------
-function Agrif_Parent_Nbstepint ( )
-!---------------------------------------------------------------------------------------------------
-    integer :: Agrif_Parent_Nbstepint ! result
-!
-    Agrif_Parent_Nbstepint = mod(Agrif_Curgrid % parent % ngridstep, int(Agrif_Parent_Rhot()))
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Parent_Nbstepint
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_InterpNearBorderX
-!
-!> Allows to interpolate (in the x direction) on a near border of the current grid if this one
-!! has a common border with the root coarse grid.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpNearBorderX ( )
-!---------------------------------------------------------------------------------------------------
-    Agrif_Curgrid % NearRootBorder(1) = .FALSE.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpNearBorderX
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_InterpDistantBorderX
-!
-!> Allows to interpolate (in the x direction) on a distant border of the current grid if this one
-!! has a common border with the root coarse grid.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpDistantBorderX ( )
-!---------------------------------------------------------------------------------------------------
-    Agrif_Curgrid % DistantRootBorder(1) = .FALSE.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpDistantBorderX
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_InterpNearBorderY
-!
-!> Allows to interpolate (in the y direction) on a near border of the current grid if this one
-!! has a common border with the root coarse grid.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpNearBorderY ( )
-!---------------------------------------------------------------------------------------------------
-    Agrif_Curgrid % NearRootBorder(2) = .FALSE.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpNearBorderY
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_InterpDistantBorderY
-!
-!> Allows to interpolate (in the y direction) on a distant border of the current grid if this one
-!! has a common border with the root coarse grid.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpDistantBorderY ( )
-!---------------------------------------------------------------------------------------------------
-    Agrif_Curgrid % DistantRootBorder(2) = .FALSE.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpDistantBorderY
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_InterpNearBorderZ
-!
-!> Allows to interpolate (in the z direction) on a near border of the current grid if this one
-!! has a common border with the root coarse grid.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpNearBorderZ ( )
-!---------------------------------------------------------------------------------------------------
-    Agrif_Curgrid % NearRootBorder(3) = .FALSE.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpNearBorderZ
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_InterpDistantBorderZ
-!
-!> Allows to interpolate (in the z direction) on a distant border of the current grid if this one
-!! has a common border with the root coarse grid.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpDistantBorderZ()
-!---------------------------------------------------------------------------------------------------
-    Agrif_Curgrid % DistantRootBorder(3) = .FALSE.
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpDistantBorderZ
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Parent_Nb_Step
-!
-!> Returns the number of time steps of the parent of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Parent_Nb_Step ( )
-!---------------------------------------------------------------------------------------------------
-    integer :: Agrif_Parent_Nb_Step ! Result
-!
-    if (Agrif_Root()) then
-        Agrif_Parent_Nb_Step = -1
-    else
-        Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
-    endif
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Parent_Nb_Step
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Root
-!
-!> Indicates if the current grid is or not the root grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Root ( )
-!---------------------------------------------------------------------------------------------------
-    logical :: Agrif_Root ! Result
-!
-    Agrif_Root = (Agrif_Curgrid % fixedrank == 0)
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Root
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_GrandMother
-!
-!> Indicates if the current grid is or not the root grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_GrandMother ( )
-!---------------------------------------------------------------------------------------------------
-    logical :: Agrif_GrandMother ! Result
-!
-    Agrif_GrandMother = Agrif_Curgrid % grand_mother_grid
-!---------------------------------------------------------------------------------------------------
-end function Agrif_GrandMother
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Parent_Root
-!
-!> Indicates if the parent of the current grid is or not the root grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Parent_Root ( )
-!---------------------------------------------------------------------------------------------------
-    logical :: Agrif_Parent_Root ! Result
-!
-    Agrif_Parent_Root = (Agrif_Curgrid % parent % fixedrank == 0)
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Parent_Root
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Fixed
-!
-!> Returns the number of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Fixed ( )
-!---------------------------------------------------------------------------------------------------
-    integer :: Agrif_Fixed   ! Result
-!
-    if (Agrif_Curgrid % fixed) then
-        Agrif_Fixed = Agrif_Curgrid % fixedrank
-    else
-        Agrif_Fixed = -1
-    endif
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Fixed
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Parent_Fixed
-!
-!> Returns the number of the parent of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Parent_Fixed ( )
-!---------------------------------------------------------------------------------------------------
-    integer :: Agrif_Parent_Fixed   ! Result
-!
-    if (Agrif_Curgrid % parent % fixed) then
-        Agrif_Parent_Fixed = Agrif_Curgrid % parent % fixedrank
-    else
-        Agrif_Parent_Fixed = 0
-    endif
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Parent_Fixed
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Is_Fixed
-!
-!> Returns .TRUE. if the current grid is fixed.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Is_Fixed ( )
-!---------------------------------------------------------------------------------------------------
-    logical :: Agrif_Is_Fixed   ! Result
-!
-    Agrif_Is_Fixed = Agrif_Curgrid % fixed
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Is_Fixed
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Parent_Is_Fixed
-!
-!> Returns .TRUE. if the parent of the current grid is fixed.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Parent_Is_Fixed ( )
-!---------------------------------------------------------------------------------------------------
-    logical :: Agrif_Parent_Is_Fixed   ! Result
-!
-    Agrif_Parent_Is_Fixed = Agrif_Curgrid % parent % fixed
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Parent_Is_Fixed
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_CFixed
-!
-!> Returns the number of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_CFixed ( )
-!---------------------------------------------------------------------------------------------------
-    character(3) :: Agrif_CFixed   ! Result
-!
-    character(3) :: cfixed
-    integer      :: fixed
-!
-    fixed = Agrif_Fixed()
-!
-    if (fixed /= -1) then
-!
-        if (fixed <= 9) then
-            write(cfixed,'(i1)') fixed
-        else
-            write(cfixed,'(i2)') fixed
-        endif
-!
-        Agrif_CFixed = cfixed
-        
-        if (associated(agrif_curgrid,agrif_coarsegrid)) then
-          Agrif_CFixed = 'gm'
-        endif
-!
-    else
-        print*,'Call to Agrif_CFixed() on a moving grid'
-        stop
-    endif
-!---------------------------------------------------------------------------------------------------
-end function Agrif_CFixed
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrid_Parent_CFixed
-!
-!> Returns the number of the parent of the current grid.
-!---------------------------------------------------------------------------------------------------
-function Agrid_Parent_CFixed ( )
-!---------------------------------------------------------------------------------------------------
-    character(3) :: Agrid_Parent_CFixed   ! Result
-!
-    character(3) :: cfixed
-    integer      :: fixed
-!
-    fixed = Agrif_Parent_Fixed()
-!
-    if(fixed /= -1) then
-!
-        if (fixed <= 9) then
-            write(cfixed,'(i1)')fixed
-        else
-            write(cfixed,'(i2)')fixed
-        endif
-!
-        Agrid_Parent_CFixed=cfixed
-!
-    else
-        print*,'Illegal call to Agrid_Parent_CFixed()'
-        stop
-    endif
-!---------------------------------------------------------------------------------------------------
-end function Agrid_Parent_CFixed
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_ChildGrid_to_ParentGrid
-!
-!> Make the pointer #Agrif_Curgrid point on the parent grid of the current grid.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_ChildGrid_to_ParentGrid ( )
-!---------------------------------------------------------------------------------------------------
-    Agrif_Curgrid % parent % save_grid => Agrif_Curgrid
-    call Agrif_Instance(Agrif_Curgrid%parent)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_ChildGrid_to_ParentGrid
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_ParentGrid_to_ChildGrid
-!
-!> Make the pointer #Agrif_Curgrid point on the child grid after having called the
-!! #Agrif_ChildGrid_to_ParentGrid subroutine.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_ParentGrid_to_ChildGrid ( )
-!---------------------------------------------------------------------------------------------------
-    call Agrif_Instance(Agrif_Curgrid%save_grid)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_ParentGrid_to_ChildGrid
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Get_Unit
-!
-!> Returns a unit not connected to any file.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Get_Unit ( )
-!---------------------------------------------------------------------------------------------------
-    integer :: Agrif_Get_Unit  ! Result
-!
-    integer :: n
-    logical :: op
-!
-    integer :: nunit
-    integer :: iii, out, iiimax
-    logical :: bexist
-    integer,dimension(1:1000) :: forbiddenunit
-!
-!   Load forbidden Unit if the file Agrif_forbidenUnit exist
-!
-    INQUIRE(file='Agrif_forbiddenUnit.txt', exist=bexist)
-!
-    if (.not. bexist) then
-!       File Agrif_forbiddenUnit.txt not found
-    else
-        nunit = 777
-        OPEN(nunit,file='Agrif_forbiddenUnit.txt', form='formatted', status="old")
-        iii = 1
-        do while ( .TRUE. )
-            READ(nunit,*, end=99) forbiddenunit(iii)
-            iii = iii + 1
-        enddo
-   99   continue
-        iiimax = iii
-        close(nunit)
-    endif
-!
-    do n = 7,1000
-!
-        INQUIRE(Unit=n,Opened=op)
-!
-        out = 0
-        if ( bexist .AND. (.NOT.op) ) then
-            do iii = 1,iiimax
-                if ( n == forbiddenunit(iii) ) out = 1
-            enddo
-        endif
-!
-        if ( (.NOT.op) .AND. (out == 0) ) exit
-!
-    enddo
-!
-    Agrif_Get_Unit = n
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Get_Unit
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_Extra_Boundary_Cells
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_Extra_Boundary_Cells ( nb_extra_cells )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: nb_extra_cells
-!
-    Agrif_Extra_Boundary_Cells = nb_extra_cells
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_Extra_Boundary_Cells
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_Efficiency
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_Efficiency ( eff )
-!---------------------------------------------------------------------------------------------------
-    real, intent(in) :: eff
-!
-    if ( (eff < 0.) .OR. (eff > 1) ) then
-        write(*,*) 'Error Efficiency should be between 0 and 1'
-        stop
-    else
-        Agrif_Efficiency = eff
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_Efficiency
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_Regridding
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_Regridding ( regfreq )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: regfreq
-!
-    if (regfreq < 0) then
-        write(*,*) 'Regridding frequency should be positive'
-        stop
-    else
-        Agrif_Regridding = regfreq
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_Regridding
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_coeffref_x
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_coeffref_x ( coeffref )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: coeffref
-
-      if (coeffref < 0) then
-         write(*,*) 'Coefficient of raffinement should be positive'
-         stop
-      else
-         Agrif_coeffref(1) = coeffref
-      endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_coeffref_x
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_coeffref_y
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_coeffref_y ( coeffref )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: coeffref
-
-    if (coeffref < 0) then
-        write(*,*) 'Coefficient of raffinement should be positive'
-        stop
-    else
-        Agrif_coeffref(2) = coeffref
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_coeffref_y
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_coeffref_z
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_coeffref_z ( coeffref )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: coeffref
-!
-    if (coeffref < 0) then
-        write(*,*) 'Coefficient of raffinement should be positive'
-        stop
-    else
-        Agrif_coeffref(3) = coeffref
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_coeffref_z
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_coeffreft_x
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_coeffreft_x ( coeffref )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: coeffref
-
-    if (coeffref < 0) then
-        write(*,*) 'Coefficient of time raffinement should be positive'
-        stop
-    else
-        Agrif_coeffreft(1) = coeffref
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_coeffreft_x
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_coeffreft_y
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_coeffreft_y ( coeffref )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: coeffref
-!
-    if (coeffref < 0) then
-        write(*,*) 'Coefficient of time raffinement should be positive'
-        stop
-    else
-        Agrif_coeffreft(2) = coeffref
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_coeffreft_y
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_coeffreft_z
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_coeffreft_z ( coeffref )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: coeffref
-
-    if (coeffref < 0) then
-        write(*,*)'Coefficient of time raffinement should be positive'
-        stop
-    else
-        Agrif_coeffreft(3) = coeffref
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_coeffreft_z
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_Minwidth
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_Minwidth ( coefminwidth )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: coefminwidth
-!
-    if (coefminwidth < 0) then
-        write(*,*)'Coefficient of Minwidth should be positive'
-        stop
-    else
-        Agrif_Minwidth = coefminwidth
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_Minwidth
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_Rafmax
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_Rafmax ( coefrafmax )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: coefrafmax
-!
-    integer :: i
-    real    :: res
-!
-    if (coefrafmax < 0) then
-        write(*,*)'Coefficient of  should be positive'
-        stop
-    else
-        res = 1.
-        do i = 1,coefrafmax-1
-            res = res * FLOAT(Agrif_coeffref(1))
-        enddo
-        if ( res == 0 ) res = 1
-        Agrif_Mind(1) = 1. / res
-!
-        res = 1.
-        do i = 1,coefrafmax-1
-            res = res * FLOAT(Agrif_coeffref(2))
-        enddo
-        if ( res == 0 ) res = 1
-        Agrif_Mind(2) = 1. / res
-!
-        res = 1.
-        do i = 1,coefrafmax-1
-            res = res * FLOAT(Agrif_coeffref(3))
-        enddo
-        if ( res == 0 ) res = 1
-        Agrif_Mind(3) = 1. / res
-!
-      endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_Rafmax
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_MaskMaxSearch
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_MaskMaxSearch ( mymaxsearch )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: mymaxsearch
-!
-    MaxSearch = mymaxsearch
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_MaskMaxSearch
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Level
-!---------------------------------------------------------------------------------------------------
-function Agrif_Level ( )
-!---------------------------------------------------------------------------------------------------
-    integer :: Agrif_Level  ! Result
-!
-    Agrif_Level = Agrif_Curgrid % level
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Level
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_MaxLevel
-!---------------------------------------------------------------------------------------------------
-function Agrif_MaxLevel ( )
-!---------------------------------------------------------------------------------------------------
-    integer :: Agrif_MaxLevel  ! Result
-!
-    Agrif_MaxLevel = Agrif_MaxLevelLoc
-!---------------------------------------------------------------------------------------------------
-end function Agrif_MaxLevel
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_GridAllocation_is_done
-!---------------------------------------------------------------------------------------------------
-function Agrif_GridAllocation_is_done ( ) result(isdone)
-!---------------------------------------------------------------------------------------------------
-    logical :: isdone
-!
-    isdone = Agrif_Curgrid % allocation_is_done
-!---------------------------------------------------------------------------------------------------
-end function Agrif_GridAllocation_is_done
-!===================================================================================================
-!
-end module Agrif_CurgridFunctions
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 10251)
@@ -0,0 +1,339 @@
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_fluxmod
+C
+      Module Agrif_fluxmod
+      Use Agrif_types
+      Use Agrif_Arrays
+      Use Agrif_Curgridfunctions
+      
+      CONTAINS  
+      
+      
+      Subroutine Agrif_AllocateFlux(Flux,fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: fluxtab
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: unitarray
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Integer :: nbout
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+      
+      unitarray = 1
+      
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            Allocate(Flux%fluxtabx)
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            Allocate(Flux%fluxtaby)
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            Allocate(Flux%fluxtabz)
+            fluxtabvar => Flux%fluxtabz
+          ENDIF
+          ALLOCATE(fluxtabvar%iarray2(2,6))
+          normalsizes=>fluxtabvar%iarray2
+          normalsizes(1,1) = 2
+          nbout = 1
+          DO n2 = 1,dimensio
+            IF (n2 .NE. n) THEN
+              nbout = nbout + 1
+              If ((Profile%posvar(n2) == 1)
+     &            .OR.(Profile%posvar(n2) == 2)) THEN
+                IF (Profile%interptab(n2) == 'x') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(1)/agrif_Curgrid%spaceref(1)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(1)/agrif_Curgrid%spaceref(1)
+                ELSE IF (Profile%interptab(n2) == 'y') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(2)/agrif_Curgrid%spaceref(2)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(2)/agrif_Curgrid%spaceref(2)
+                ELSE IF (Profile%interptab(n2) == 'z') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(3)/agrif_Curgrid%spaceref(3)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(3)/agrif_Curgrid%spaceref(3)
+                ENDIF
+              ELSE
+                normalsizes(2,n2) = SIZE(fluxtab,n2)
+                normalsizes(1,nbout) = SIZE(fluxtab,n2)
+              ENDIF
+            ENDIF
+          ENDDO          
+        ENDIF
+      enddo
+      
+      
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF
+          Call Agrif_nbdim_allocation(fluxtabvar,unitarray(1:dimensio),
+     &          fluxtabvar%iarray2(1,1:dimensio),dimensio)
+        ENDIF
+      enddo
+      
+      Flux%fluxallocated = .TRUE.
+      
+      End Subroutine Agrif_AllocateFlux
+      
+      FUNCTION Agrif_Search_Flux(fluxname)
+      character*(*) fluxname
+      Type(Agrif_Flux), Pointer :: Agrif_Search_Flux
+      
+      Type(Agrif_Flux), pointer :: parcours
+      Logical :: foundflux
+      
+      foundflux = .FALSE.
+      parcours => Agrif_Curgrid%fluxes
+      
+      Do While (Associated(parcours))
+         IF (parcours % fluxname == fluxname) THEN
+           foundflux = .TRUE.
+           EXIT
+         ENDIF
+         parcours => parcours%nextflux
+      End Do
+      
+      IF (.NOT.foundflux) THEN
+      write(*,*) 'The array flux '''
+     &           //TRIM(fluxname)//''' has not been declared'
+      stop
+      ENDIF      
+      
+      Agrif_Search_Flux => parcours
+      
+      End Function Agrif_Search_Flux
+      
+      Subroutine Agrif_Save_Fluxtab(Flux,Fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: Fluxtab
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: normalsizes2, normalsizes3
+      INTEGER, DIMENSION(6) :: unitarray2, unitarray3
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2,j,j1,j2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+          normalsizes => fluxtabvar%iarray2
+          unitarray2 = 1
+          unitarray3 = 1
+          normalsizes2 = normalsizes(1,:)
+          normalsizes3 = normalsizes(2,:)
+          
+          unitarray3(n) = Profile%point(n)
+          normalsizes3(n) = Profile%point(n) 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            j1 = unitarray3(2)
+            Do j=unitarray3(2),normalsizes3(2)
+            do j2 = j1,j1+Agrif_curgrid%spaceref(2)
+!            print *,'flux stocke fiun = ',j2,fluxtab(unitarray3(1),j2)
+            enddo
+            fluxtabvar%array2(1:1,j) = 
+     &      fluxtabvar%array2(1:1,j) +
+     &             SUM(fluxtab(unitarray3(1):normalsizes3(1),
+     &                        j1:j1+Agrif_Curgrid%spaceref(2)))
+             j1 = j1+Agrif_Curgrid%spaceref(2)
+            EndDo
+          END SELECT
+          
+          unitarray3(n) = Profile%point(n)+Agrif_Curgrid%nb(n)
+          normalsizes3(n) = Profile%point(n)+Agrif_Curgrid%nb(n) 
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            j1 = unitarray3(2)
+            Do j=unitarray3(2),normalsizes3(2)
+            fluxtabvar%array2(2:2,j) = 
+     &      fluxtabvar%array2(2:2,j) +
+     &             SUM(fluxtab(unitarray3(1):normalsizes3(1),
+     &                        j1:j1+Agrif_Curgrid%spaceref(2)))
+             j1 = j1+Agrif_Curgrid%spaceref(2)
+            EndDo
+         END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Save_Fluxtab
+
+      Subroutine Agrif_Save_Fluxtab_child(Flux,Fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: Fluxtab
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: normalsizes2, normalsizes3
+      INTEGER, DIMENSION(6) :: unitarray2, unitarray3
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+          normalsizes => fluxtabvar%iarray2
+          unitarray2 = 1
+          unitarray3 = 1
+          normalsizes2 = normalsizes(1,:)
+          normalsizes3 = normalsizes(2,:)
+          
+          unitarray3(n) = Profile%point(n)+Agrif_Curgrid%ix(n)
+          normalsizes3(n) = unitarray3(n)
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2(1:1,
+     &                        unitarray2(2):normalsizes2(2)) = 
+     &      - fluxtab(unitarray3(1):normalsizes3(1),
+     &                        unitarray3(2):normalsizes3(2))
+!        print *,'flux stocke = ',fluxtab(unitarray3(1):normalsizes3(1),
+!     &                        unitarray3(2):normalsizes3(2))
+          END SELECT
+          
+          unitarray3(n) = unitarray3(n)+
+     &         Agrif_Curgrid%nb(n)/Agrif_Curgrid%spaceref(n)
+          normalsizes3(n) = unitarray3(n)
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2(2:2,
+     &                        unitarray2(2):normalsizes2(2)) = 
+     &      - fluxtab(unitarray3(1):normalsizes3(1),
+     &                        unitarray3(2):normalsizes3(2))    
+         END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Save_Fluxtab_child
+      
+      Subroutine Agrif_Cancel_Fluxarray(Flux)
+      Type(Agrif_Flux), Pointer :: Flux
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2 = 0.
+          END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Cancel_Fluxarray  
+      
+      Subroutine Agrif_FluxCorrect(Flux, procname)
+      Type(Agrif_Flux), Pointer :: Flux
+      External :: procname
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2,j1,j2
+      Integer, Dimension(:), Allocatable :: Loctab
+      Integer :: locind
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+            locind = 1
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+            locind = 2
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+            locind = 3
+          ENDIF 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+           Allocate(Loctab(2))
+           Loctab(1) = Agrif_Curgrid%ix(locind)
+           Loctab(2) = Agrif_Curgrid%ix(locind)+
+     &         Agrif_Curgrid%nb(locind)/Agrif_Curgrid%spaceref(locind)
+           j1 = agrif_curgrid%ix(2)
+           j2 = agrif_curgrid%ix(2)+
+     &        agrif_curgrid%nb(2)/Agrif_curgrid%spaceref(2)
+           Call Agrif_ChildGrid_to_ParentGrid()
+            Call procname(fluxtabvar%array2,Loctab(1),Loctab(2),j1,j2)
+           Call Agrif_ParentGrid_to_ChildGrid()
+          END SELECT
+        ENDIF
+      enddo
+      
+      If (Allocated(Loctab)) Deallocate(Loctab)
+                  
+      End Subroutine Agrif_FluxCorrect 
+          
+      End Module Agrif_fluxmod
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 10250)
+++ 	(revision )
@@ -1,478 +1,0 @@
-module Agrif_Grids
-
-    use Agrif_Types
-!
-    implicit none
-!
-!===================================================================================================
-type Agrif_Grid_List
-!---------------------------------------------------------------------------------------------------
-!<  List of grids.
-!
-    integer                     :: nitems = 0      !< Number of elements in the list
-    type(Agrif_PGrid), pointer  :: first => NULL() !< Pointer to the first grid in the list
-    type(Agrif_PGrid), pointer  :: last  => NULL() !< Pointer to the last  grid inserted in the list
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Grid_List
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_PGrid
-!---------------------------------------------------------------------------------------------------
-!<  Data type to go over the grid hierarchy (used for the creation of this grid hierarchy
-!<  and during the time integration).
-!
-    type(Agrif_Grid) , pointer :: gr   => NULL()  !< Pointer to the actual grid data structure
-    type(Agrif_PGrid), pointer :: next => NULL()  !< Next grid in the list
-!
-!---------------------------------------------------------------------------------------------------
-end type Agrif_PGrid
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Grid
-!---------------------------------------------------------------------------------------------------
-!<  Data type to define a grid (position, space and time refinement factors).
-!
-    type(Agrif_Grid)                    , pointer :: parent      => NULL() !< pointer on the parent grid
-    type(Agrif_Grid)                    , pointer :: save_grid   => NULL() !< pointer on the save grid
-    type(Agrif_Grid_List)                         :: child_list            !< List of child grids
-    type(Agrif_Variable),   dimension(:), allocatable :: tabvars    !< List of grid variables
-    type(Agrif_Variable_c), dimension(:), allocatable :: tabvars_c  !< List of character grid variables
-    type(Agrif_Variable_r), dimension(:), allocatable :: tabvars_r  !< List of real      grid variables
-    type(Agrif_Variable_l), dimension(:), allocatable :: tabvars_l  !< List of logical   grid variables
-    type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i  !< List of integer   grid variables
-!
-    real   , dimension(3)              :: Agrif_x   !< global x, y and z position
-    real   , dimension(3)              :: Agrif_dx  !< global space step in the x, y and z direction
-    real   , dimension(3)              :: Agrif_dt  !< global time  step in the x, y and z direction
-    integer, dimension(3)              :: nb        !< number of cells in the x, y and z direction
-    integer, dimension(3)              :: ix        !< minimal position in the x, y and z direction
-    integer, dimension(3)              :: spaceref  !< space refinement factor in the x, y and z direction
-    integer, dimension(3)              :: timeref   !< Time refinement factor in the x, y and z direction
-    integer                            :: ngridstep !< number of time steps
-    integer                            :: rank
-    integer                            :: grid_id   !< moving grid id
-    integer                            :: fixedrank !< number of the grid
-    logical                            :: fixed     !< fixed or moving grid ?
-    logical                            :: oldgrid
-!> \name Logicals indicating if the current grid has a common border with the root coarse grid
-!> @{
-    logical, dimension(3)              :: NearRootBorder
-    logical, dimension(3)              :: DistantRootBorder
-!> @}
-!> \name Arrays for adaptive grid refinement
-!> @{
-    integer, dimension(:)    ,   allocatable :: tabpoint1D
-    integer, dimension(:,:)  ,   allocatable :: tabpoint2D
-    integer, dimension(:,:,:),   allocatable :: tabpoint3D
-!> @}
-!> \name Members for parallel integration
-!> @{
-    type(Agrif_Rectangle),  pointer    :: rect_in_parent => NULL()
-    type(Agrif_Grid_List)              :: neigh_list                !< List of neighboring grids (ie. connected through a common proc)
-    type(Agrif_Proc_List)              :: proc_def_list             !< List of procs that will integrate this grid
-    type(Agrif_Proc_List)              :: proc_def_in_parent_list   !< List of procs that will integrate this grid (defined as in the parent grid)
-    type(Agrif_Proc_List)              :: required_proc_list        !< List of procs that are required for this grid
-    type(Agrif_Sequence_List), pointer :: child_seq => NULL()       !< Sequence for childs
-    integer                            :: seq_num = 0
-    integer                            :: size = 0
-    integer                            :: dsat = 0
-#if defined AGRIF_MPI
-    integer                            :: communicator = -1
-#endif
-!> @}
-    type(Agrif_Variables_List), pointer :: variables => NULL()
-    integer                             :: NbVariables = 0
-    integer                             :: level    !< level of the grid in the hierarchy
-    logical                             :: allocation_is_done = .false.
-    logical                             :: grand_mother_grid = .false.
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Grid
-!===================================================================================================
-!
-!> this pointer always points on the root grid of the grid hierarchy
-type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL()
-
-!> this pointer always points on the grand mother grid of the grid hierarchy (if any)
-type(Agrif_Grid) , pointer :: Agrif_Coarsegrid => NULL()
-
-!> Grid list used in the \link Agrif_Util::Agrif_Regrid() Agrif_regrid \endlink subroutine.
-!> It contains  the safeguard of the grid hierarchy.
-type(Agrif_Grid_List), pointer :: Agrif_oldmygrid => NULL()
-
-!> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init))
-type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL()
-!
-!===================================================================================================
-type Agrif_Sequence
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List) :: gridlist
-    type(Agrif_Proc_List) :: proclist
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Sequence
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Sequence_List
-!---------------------------------------------------------------------------------------------------
-    integer :: nb_seqs
-    type(Agrif_Sequence), dimension(:), allocatable :: sequences
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Sequence_List
-!===================================================================================================
-!
-interface
-    function compare_grids ( grid1, grid2 ) result( res )
-        import Agrif_Grid
-        type(Agrif_Grid), intent(in)    :: grid1
-        type(Agrif_Grid), intent(in)    :: grid2
-        integer                         :: res  !< Result of the comparison :
-                                                !!  - res  < 0   if grid1 <  grid2
-                                                !!  - res == 0   if grid1 == grid2
-                                                !!  - res  > 0   if grid1 >  grid2
-    end function compare_grids
-end interface
-!
-contains
-!
-!===================================================================================================
-subroutine Agrif_gl_print ( gridlist )
-!
-!< DEBUG : a virer à terme.
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(in)   :: gridlist
-!
-    type(Agrif_PGrid), pointer  :: gridp
-    type(Agrif_Grid),  pointer  :: grid
-!
-    gridp => gridlist % first
-    do while ( associated(gridp) )
-        grid => gridp % gr
-        write(*,'("G",i0,", ")', advance='no') grid % fixedrank
-        gridp => gridp % next
-    enddo
-    write(*,*)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_gl_print
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_gl_print_debug ( gridlist )
-!
-!< DEBUG : a virer à terme.
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(in)   :: gridlist
-!
-    type(Agrif_PGrid), pointer  :: gridp
-    type(Agrif_Grid),  pointer  :: grid
-!
-    write(*,'(" (nitems=",i2,"), (id,neighs,color,dsat,size) = ")', advance='no') gridlist % nitems
-    gridp => gridlist % first
-    do while ( associated(gridp) )
-        grid => gridp % gr
-        write(*,'("(G",i0,4(",",i0),"), ")', advance='no') grid % fixedrank, &
-            grid % neigh_list % nitems, grid % seq_num, grid % dsat, grid % size
-        gridp => gridp % next
-    enddo
-    write(*,*)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_gl_print_debug
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_gl_append ( gridlist, grid )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List),     intent(inout)  :: gridlist
-    type(Agrif_Grid), pointer, intent(in)     :: grid
-!
-    type(Agrif_PGrid), pointer   :: new_gp
-!
-    allocate( new_gp )
-!
-    new_gp % gr   => grid
-    new_gp % next => NULL()
-!
-    if ( associated(gridlist % last) ) then
-    ! the list is not empty, append the new pointer at the end
-        gridlist % last % next => new_gp
-    else
-    ! the list is empty, the new pointer is the first one
-        gridlist % first => new_gp
-    endif
-    ! anyway, for next time 'grid' will be the last one.
-    gridlist % last => new_gp
-    gridlist % nitems = gridlist % nitems + 1
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_gl_append
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_gl_popfirst ( gridlist ) result ( grid )
-!
-!<  Removes the first item of the list and returns it.
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(inout)    :: gridlist
-!
-    type(Agrif_PGrid), pointer :: grid_p
-    type(Agrif_Grid),  pointer :: grid
-!
-    grid_p => gridlist % first
-!
-    if ( .not. associated( grid_p ) ) then
-        grid => NULL()
-        return
-    endif
-!
-    grid              => grid_p % gr
-    gridlist % first  => grid_p % next
-    gridlist % nitems =  gridlist % nitems - 1
-    if ( .not. associated(gridlist % first) ) then
-       nullify(gridlist % last)
-    endif
-    deallocate(grid_p)
-!---------------------------------------------------------------------------------------------------
-end function Agrif_gl_popfirst
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_gl_copy ( new_gl, model )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(out)  :: new_gl
-    type(Agrif_Grid_List), intent(in)   :: model
-!
-    type(Agrif_PGrid), pointer :: gp
-!
-    call Agrif_gl_clear(new_gl)
-    gp => model % first
-!
-    do while( associated(gp) )
-        call Agrif_gl_append( new_gl, gp % gr )
-        gp => gp % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_gl_copy
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_gl_build_from_gp ( gridp ) result ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_PGrid), pointer, intent(in)   :: gridp
-!
-    type(Agrif_Grid_List), pointer  :: gridlist
-    type(Agrif_PGrid),     pointer  :: gp
-!
-    allocate(gridlist)
-!
-    gp => gridp
-!
-    do while ( associated( gp ) )
-        call Agrif_gl_append( gridlist, gp % gr )
-        gp => gp % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end function Agrif_gl_build_from_gp
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_gp_delete ( gridp )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_PGrid), pointer, intent(inout)  :: gridp
-!
-    type(Agrif_PGrid), pointer   :: gp, gpd
-!
-    if ( .not. associated( gridp ) ) return
-!
-    gp => gridp
-!
-    do while( associated(gp) )
-        gpd => gp
-        gp  => gp % next
-        deallocate(gpd)
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_gp_delete
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_gl_clear ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(inout)  :: gridlist
-!
-    call Agrif_gp_delete(gridlist % first)
-    gridlist % first => NULL()
-    gridlist % last  => NULL()
-    gridlist % nitems = 0
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_gl_clear
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_gl_delete ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), pointer, intent(inout)  :: gridlist
-!
-    if ( .not. associated( gridlist ) ) return
-!
-    call Agrif_gp_delete(gridlist % first)
-    deallocate( gridlist )
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_gl_delete
-!===================================================================================================
-!
-!===================================================================================================
-recursive function Agrif_gl_merge_sort ( gridlist, compare_func, compare_func_opt ) result( gl_sorted )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(in)    :: gridlist
-    procedure(compare_grids)             :: compare_func
-    procedure(compare_grids), optional   :: compare_func_opt
-!
-    type(Agrif_Grid_List), pointer  :: gl_sorted
-    type(Agrif_Grid_List), pointer  :: gl_left,  gl_sorted_left
-    type(Agrif_Grid_List), pointer  :: gl_right, gl_sorted_right
-    type(Agrif_PGrid),     pointer  :: grid_p
-    integer                         :: n, middle
-!
-! if list size is 1, consider it sorted and return it
-    if  ( (gridlist % nitems <= 1) ) then
-        gl_sorted => Agrif_gl_build_from_gp(gridlist % first)
-        return
-    endif
-!
-! else split the list into two sublists
-    n = 1
-    middle    =  gridlist % nitems / 2
-    grid_p    => gridlist % first
-!
-    allocate( gl_left, gl_right )
-!
-    do while ( associated(grid_p) )
-        if ( n <= middle ) then
-            call Agrif_gl_append(gl_left,  grid_p % gr)
-        else
-            call Agrif_gl_append(gl_right, grid_p % gr)
-        endif
-        grid_p => grid_p % next
-        n = n+1
-    enddo
-!
-! recursively call Agrif_gl_merge_sort() to further split each sublist until sublist size is 1
-    gl_sorted_left  => Agrif_gl_merge_sort(gl_left,  compare_func, compare_func_opt)
-    gl_sorted_right => Agrif_gl_merge_sort(gl_right, compare_func, compare_func_opt)
-!
-! merge the sublists returned from prior calls to gl_merge_sort() and return the resulting merged sublist
-    gl_sorted => Agrif_gl_merge(gl_sorted_left, gl_sorted_right, compare_func, compare_func_opt)
-!
-    call Agrif_gl_delete( gl_left )
-    call Agrif_gl_delete( gl_right )
-    call Agrif_gl_delete( gl_sorted_left )
-    call Agrif_gl_delete( gl_sorted_right )
-!---------------------------------------------------------------------------------------------------
-end function Agrif_gl_merge_sort
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_gl_merge ( gl_left, gl_right, compare_func, compare_func_opt ) result( gl_merged )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(inout)    :: gl_left
-    type(Agrif_Grid_List), intent(inout)    :: gl_right
-    procedure(compare_grids)                :: compare_func
-    procedure(compare_grids), optional      :: compare_func_opt
-!
-    type(Agrif_Grid_List), pointer  :: gl_merged
-    type(Agrif_Grid),      pointer  :: poped_grid
-    integer                         :: comp_value
-!
-    allocate( gl_merged )
-!
-    do while ( gl_left % nitems > 0 .or. gl_right % nitems > 0 )
-!
-        if ( gl_left % nitems > 0 .and. gl_right % nitems > 0 ) then
-!
-!         Let.s compare both items with the first compare function
-            comp_value = compare_func( gl_left % first % gr, gl_right % first % gr )
-!
-            if     ( comp_value < 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
-            elseif ( comp_value > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
-            else ! ( comp_value == 0 )
-!
-!             Both items are equal, let.s use the second criterion if the optional
-!             compare function is present.
-                if ( present(compare_func_opt) ) then
-!
-                    comp_value = compare_func_opt( gl_left % first % gr, gl_right % first % gr )
-!
-                    if ( comp_value <= 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
-                    else                        ; poped_grid => Agrif_gl_popfirst(gl_right)
-                    endif
-                else
-!                 If the second criterion is not present, let.s just pick the left item
-                    poped_grid => Agrif_gl_popfirst(gl_left)
-                endif
-            endif
-!
-!     If one of the lists is empty, we just have to pick in the other one.
-        elseif ( gl_left  % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
-        elseif ( gl_right % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
-        endif
-!
-        call Agrif_gl_append( gl_merged, poped_grid )
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end function Agrif_gl_merge
-!===================================================================================================
-!
-!===================================================================================================
-function compare_grid_degrees ( grid1, grid2 ) result( res )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(in)    :: grid1
-    type(Agrif_Grid), intent(in)    :: grid2
-!
-    integer     :: res
-!
-    res = grid2 % neigh_list % nitems - grid1 % neigh_list % nitems
-!---------------------------------------------------------------------------------------------------
-end function compare_grid_degrees
-!===================================================================================================
-!
-!===================================================================================================
-function compare_colors ( grid1, grid2 ) result( res )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(in)    :: grid1
-    type(Agrif_Grid), intent(in)    :: grid2
-!
-    integer     :: res
-!
-    res = grid1 % seq_num - grid2 % seq_num
-!---------------------------------------------------------------------------------------------------
-end function compare_colors
-!===================================================================================================
-!
-!===================================================================================================
-function compare_dsat_values ( grid1, grid2 ) result( res )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(in)    :: grid1
-    type(Agrif_Grid), intent(in)    :: grid2
-!
-    integer     :: res
-!
-    res = grid2 % dsat - grid1 % dsat
-!---------------------------------------------------------------------------------------------------
-end function compare_dsat_values
-!===================================================================================================
-!
-!===================================================================================================
-function compare_size_values ( grid1, grid2 ) result( res )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(in)    :: grid1
-    type(Agrif_Grid), intent(in)    :: grid2
-!
-    integer     :: res
-!
-    res = grid2 % size - grid1 % size
-!---------------------------------------------------------------------------------------------------
-end function compare_size_values
-!===================================================================================================
-!
-end module Agrif_Grids
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 10251)
@@ -0,0 +1,252 @@
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Init
+C
+      Module Agrif_Init 
+C
+CCC   Description:
+CCC   Several operations on the variables of the current grid (creation,
+CCC   instanciation, ...) used during the creation of the grid hierarchy and
+CCC   during the time integration.
+C
+C     Modules used: 
+C
+      Use Agrif_Types 
+      Use Agrif_link
+C   
+      IMPLICIT NONE
+C
+      Contains
+C     Defininition of the procedures contained in this module
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Allocation  
+C     **************************************************************************
+C  
+      Subroutine Agrif_Allocation(Agrif_Gr)
+C
+CCC   Description:
+CCC   Subroutine to allocate the arrays containing the values of the variables 
+CCC   of the current grd.
+C
+CC    Method:
+CC    Use of the allocate function.  
+C
+C     Declarations:
+C      
+C     Pointer argument:
+      TYPE(AGRIF_grid), Pointer :: Agrif_Gr  ! Pointer on the current grid
+C 
+C     Allocation of the arrays of the variables  
+C     We cut this in several files to avoid long compilation timings
+C
+      Call Agrif_Allocationcalls(Agrif_Gr)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C
+         if ( Agrif_Probdim .EQ. 1 ) 
+     &      Allocate(Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1))
+         if ( Agrif_Probdim .EQ. 2 ) 
+     &      Allocate(Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1,
+     &       Agrif_Gr%nb(2)+1))      
+         if ( Agrif_Probdim .EQ. 3 ) 
+     &      Allocate(Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1,
+     &       Agrif_Gr%nb(2)+1,Agrif_Gr%nb(3)+1))      
+C
+      endif
+C 
+      End Subroutine Agrif_Allocation
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Instance 
+C     **************************************************************************
+C 
+      Subroutine Agrif_Instance(Agrif_Gr)
+C
+CCC   Description:
+CCC   Subroutine to do an instance of the common variables to the variables of  
+CCC   the current grid.
+C
+CC    Method:
+CC    Pointing the common variables on these of the current grid.  
+C
+C     Declarations:
+C        
+
+C
+C
+
+C
+C     Pointer argument: 
+      Type(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+C 
+C
+      Agrif_Curgrid => Agrif_Gr
+      Agrif_tabvars => Agrif_Curgrid % tabvars
+C
+      Call Agrif_Get_numberofcells(Agrif_Gr)
+C
+C
+C     Calculation of isf,jsf,nzsf and of the index of the output file 
+      Call Agrif_InitWorkSpace() 
+C
+C 
+      End Subroutine Agrif_Instance
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_initialisations  
+C     **************************************************************************
+      Subroutine Agrif_initialisations(Agrif_Gr)
+C
+CCC   Description:
+C
+CC    Method:
+C
+C     Declarations:
+C        
+      INTEGER :: i
+C
+C     Pointer argument: 
+      Type(Agrif_Grid), Pointer  :: Agrif_Gr
+      
+C
+      do i = 1 , Agrif_NbVariables
+C 
+         Agrif_Gr % tabvars(i) % var % nbdim = 0
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%array1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+             Agrif_Gr % tabvars(i) % var % lb(1:1) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array1)
+             Agrif_Gr % tabvars(i) % var % ub(1:1) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array1)     
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+             Agrif_Gr % tabvars(i) % var % lb(1:2) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array2)
+             Agrif_Gr % tabvars(i) % var % ub(1:2) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array2)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+             Agrif_Gr % tabvars(i) % var % lb(1:3) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array3)
+             Agrif_Gr % tabvars(i) % var % ub(1:3) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array3)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+             Agrif_Gr % tabvars(i) % var % lb(1:4) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array4)
+             Agrif_Gr % tabvars(i) % var % ub(1:4) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array4)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+             Agrif_Gr % tabvars(i) % var % lb(1:5) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array5)
+             Agrif_Gr % tabvars(i) % var % ub(1:5) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array5)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+             Agrif_Gr % tabvars(i) % var % lb(1:6) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array6)
+             Agrif_Gr % tabvars(i) % var % ub(1:6) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array6)
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%carray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%carray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+C 
+      enddo
+C
+      Return
+C 
+C
+      End Subroutine Agrif_initialisations
+C 
+C
+      End Module AGRIF_Init 
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 10250)
+++ 	(revision )
@@ -1,209 +1,0 @@
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_Init.
-!>
-!> Several operations on the variables of the current grid (creation, instanciation, ...)
-!! used during the creation of the grid hierarchy and during the time integration.
-!
-module Agrif_Init
-!
-    use Agrif_Grids
-    use Agrif_Link
-    use Agrif_Mpp
-!
-    implicit none
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_Allocation
-!
-!> Allocates the arrays containing the values of the variables of the current grd.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Allocation ( Agrif_Gr, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid),       pointer   :: Agrif_Gr   !< Pointer on the current grid
-    procedure(alloc_proc),  optional  :: procname   !< Allocation procedure (Default: Agrif_Allocationcalls)
-!
-    if ( present(procname) ) then
-        call procname(Agrif_Gr)
-    else
-        call Agrif_Allocationcalls(Agrif_Gr)
-    endif
-    Agrif_Gr % allocation_is_done = .true.
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
-!
-        if ( Agrif_Probdim == 1 ) allocate( Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1) )
-        if ( Agrif_Probdim == 2 ) allocate( Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1, &
-                                                                Agrif_Gr%nb(2)+1) )
-        if ( Agrif_Probdim == 3 ) allocate( Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1, &
-                                                                Agrif_Gr%nb(2)+1, &
-                                                                Agrif_Gr%nb(3)+1) )
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Allocation
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Instance
-!
-!> Make the pointer Agrif_Types::Agrif_Curgrid point to Agrif_Gr
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Instance ( Agrif_Gr )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
-!
-    Agrif_Curgrid => Agrif_Gr
-    Agrif_tabvars => Agrif_Curgrid % tabvars
-    Agrif_tabvars_c => Agrif_Curgrid % tabvars_c
-    Agrif_tabvars_r => Agrif_Curgrid % tabvars_r
-    Agrif_tabvars_l => Agrif_Curgrid % tabvars_l
-    Agrif_tabvars_i => Agrif_Curgrid % tabvars_i
-!
-#if defined AGRIF_MPI
-    if ( Agrif_Gr % communicator /= -1 ) then
-        call Agrif_MPI_switch_comm( Agrif_Gr % communicator )
-    endif
-#endif
-!
-    call Agrif_Get_numberofcells(Agrif_Gr)
-    call Agrif_InitWorkSpace()
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Instance
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_initialisations
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_initialisations ( Agrif_Gr )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
-!
-    integer                         :: i
-    type(Agrif_Variable),   pointer :: var => NULL()
-    type(Agrif_Variable_c), pointer :: var_c => NULL()
-    type(Agrif_Variable_r), pointer :: var_r => NULL()
-    type(Agrif_Variable_l), pointer :: var_l => NULL()
-    type(Agrif_Variable_i), pointer :: var_i => NULL()
-!
-    do i = 1,Agrif_NbVariables(0)
-!
-        var => Agrif_Gr % tabvars(i)
-        var % nbdim = 0
-!
-        if (allocated(var%array1)) then
-            var % nbdim = 1
-            var % lb(1:1) = lbound(var%array1)
-            var % ub(1:1) = ubound(var%array1)
-        endif
-        if (allocated(var%array2)) then
-            var % nbdim = 2
-            var % lb(1:2) = lbound(var%array2)
-            var % ub(1:2) = ubound(var%array2)
-        endif
-        if (allocated(var%array3)) then
-            var % nbdim = 3
-            var % lb(1:3) = lbound(var%array3)
-            var % ub(1:3) = ubound(var%array3)
-        endif
-        if (allocated(var%array4)) then
-            var % nbdim = 4
-            var % lb(1:4) = lbound(var%array4)
-            var % ub(1:4) = ubound(var%array4)
-        endif
-        if (allocated(var%array5)) then
-            var % nbdim = 5
-            var % lb(1:5) = lbound(var%array5)
-            var % ub(1:5) = ubound(var%array5)
-        endif
-        if (allocated(var%array6)) then
-            var % nbdim = 6
-            var % lb(1:6) = lbound(var%array6)
-            var % ub(1:6) = ubound(var%array6)
-        endif
-!
-        if (allocated(var%darray1)) var % nbdim = 1
-        if (allocated(var%darray2)) var % nbdim = 2
-        if (allocated(var%darray3)) var % nbdim = 3
-        if (allocated(var%darray4)) var % nbdim = 4
-        if (allocated(var%darray5)) var % nbdim = 5
-        if (allocated(var%darray6)) var % nbdim = 6
-!
-        if (allocated(var%sarray1)) var % nbdim = 1
-        if (allocated(var%sarray2)) var % nbdim = 2
-        if (allocated(var%sarray3)) var % nbdim = 3
-        if (allocated(var%sarray4)) var % nbdim = 4
-        if (allocated(var%sarray5)) var % nbdim = 5
-        if (allocated(var%sarray6)) var % nbdim = 6
-!
-    enddo
-
-    do i = 1,Agrif_NbVariables(1)
-!
-        var_c => Agrif_Gr % tabvars_c(i)
-        var_c % nbdim = 0
-!
-        if (allocated(var_c%carray1)) var_c % nbdim = 1
-        if (allocated(var_c%carray2)) var_c % nbdim = 2
-!
-    enddo
-
-    do i = 1,Agrif_NbVariables(2)
-!
-        var_r => Agrif_Gr % tabvars_r(i)
-        var_r % nbdim = 0
-!
-    enddo
-
-    do i = 1,Agrif_NbVariables(3)
-!
-        var_l => Agrif_Gr % tabvars_l(i)
-        var_l % nbdim = 0
-!
-        if (allocated(var_l%larray1)) var_l % nbdim = 1
-        if (allocated(var_l%larray2)) var_l % nbdim = 2
-        if (allocated(var_l%larray3)) var_l % nbdim = 3
-        if (allocated(var_l%larray4)) var_l % nbdim = 4
-        if (allocated(var_l%larray5)) var_l % nbdim = 5
-        if (allocated(var_l%larray6)) var_l % nbdim = 6
-!
-    enddo
-
-    do i = 1,Agrif_NbVariables(4)
-!
-        var_i => Agrif_Gr % tabvars_i(i)
-        var_i % nbdim = 0
-!
-        if (allocated(var_i%iarray1)) var_i % nbdim = 1
-        if (allocated(var_i%iarray2)) var_i % nbdim = 2
-        if (allocated(var_i%iarray3)) var_i % nbdim = 3
-        if (allocated(var_i%iarray4)) var_i % nbdim = 4
-        if (allocated(var_i%iarray5)) var_i % nbdim = 5
-        if (allocated(var_i%iarray6)) var_i % nbdim = 6
-!
-    enddo
-
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_initialisations
-!===================================================================================================
-!
-end module Agrif_Init
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 10251)
@@ -0,0 +1,125 @@
+!
+! $Id: modinitvars.F 2528 2010-12-27 17:33:53Z rblod $
+!
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Init_Vars
+C
+      Module Agrif_Init_Vars
+C
+CCC   Description:
+CCC   Initialization of the variables of the current grid.
+C
+C     Modules used: 
+C      
+      Use Agrif_Types
+      Use Agrif_link
+C   
+      IMPLICIT NONE
+C
+      Contains
+C     Defininition of the procedures contained in this module 
+C  
+C 
+C     **************************************************************************
+CCC   Subroutine Agrif_Create_var 
+C     **************************************************************************
+C  
+      Subroutine Agrif_Create_Var(Agrif_Gr)
+C
+CCC   Description:
+CCC   Allocation of the field "var" of the grid variables.
+CCC   Fields "root_var", "nbdim" and "parent_var" of the grid variables.
+CCC   Array "tabvars" of the current grid. 
+C
+CC    Method:                  
+C 
+C     Declarations:
+C
+      
+C
+C     Pointer argument:
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
+      INTEGER :: nb
+C
+C     Array "tabvars" of the current grid. 
+C
+      Allocate(Agrif_Gr % tabvars(Agrif_NbVariables))
+C      
+      do nb = 1, Agrif_NbVariables
+        Allocate(Agrif_Gr % tabvars(nb) % var)
+      enddo
+
+C     Fields "root_var", "nbdim" and "parent_var" of the grid variables.     
+      if (Agrif_Gr % fixedrank .NE.0) then
+         do nb = 1, Agrif_NbVariables     
+            Agrif_Gr % tabvars(nb) % parent_var => 
+     &      Agrif_Gr % parent %tabvars(nb)
+            Agrif_Gr % tabvars(nb) % var % nbdim =
+     &      Agrif_Mygrid % tabvars(nb) % var % nbdim
+            Agrif_Gr % tabvars(nb) % var % root_var =>
+     &      Agrif_Mygrid % tabvars(nb) % var          
+         enddo
+      endif
+C           
+      End Subroutine Agrif_Create_Var
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CreateVar
+C     **************************************************************************
+C 
+      Subroutine Agrif_CreateVar(Agrif_Gr)            
+C
+CCC   Description:
+CCC   This subroutine allows to make a link between Mygrid and the current grid 
+C
+C     Modules used:
+C      
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr    ! Pointer on the current grid
+      INTEGER                    :: i           ! Loop
+C
+      if (Agrif_Gr % fixedrank .NE. 0) then
+C  
+         do i = 1 , Agrif_NbVariables 
+            Agrif_Gr % tabvars(i) % parent_var => 
+     &      Agrif_Gr % parent % tabvars(i) 
+            Agrif_Gr % tabvars(i) % var % root_var => 
+     &      Agrif_Mygrid % tabvars(i) % var
+            Agrif_Gr % tabvars(i) % var % nbdim  = 
+     &      Agrif_Gr % parent % tabvars(i) % var % nbdim
+         enddo 
+C	 
+      endif 
+C       
+      End Subroutine Agrif_CreateVar
+C
+C
+C
+      End Module Agrif_Init_Vars
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 10250)
+++ 	(revision )
@@ -1,86 +1,0 @@
-!
-! $Id$
-!
-!     Agrif (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_Init_Vars
-!>
-!> Initialization of the variables of the current grid.
-!
-module Agrif_Init_Vars
-!
-    use Agrif_Types
-    use Agrif_Grids
-    use Agrif_Link
-!
-    implicit none
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_Create_Var
-!
-!> Allocation of the list of grid variables for grid Agrif_Gr.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Create_Var ( Agrif_Gr )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: Agrif_Gr  !< Pointer on the current grid
-!
-    integer :: nb
-!
-    if (Agrif_NbVariables(0) > 0) allocate(Agrif_Gr % tabvars  (Agrif_NbVariables(0)))
-    if (Agrif_NbVariables(1) > 0) allocate(Agrif_Gr % tabvars_c(Agrif_NbVariables(1)))
-    if (Agrif_NbVariables(2) > 0) allocate(Agrif_Gr % tabvars_r(Agrif_NbVariables(2)))
-    if (Agrif_NbVariables(3) > 0) allocate(Agrif_Gr % tabvars_l(Agrif_NbVariables(3)))
-    if (Agrif_NbVariables(4) > 0) allocate(Agrif_Gr % tabvars_i(Agrif_NbVariables(4)))
-!
-    if ( Agrif_Gr % fixedrank /= 0 ) then
-        do nb = 1, Agrif_NbVariables(0)
-            Agrif_Gr % tabvars(nb) % parent_var => Agrif_Gr % parent % tabvars(nb)
-            Agrif_Gr % tabvars(nb) % nbdim      =  Agrif_Mygrid % tabvars(nb) % nbdim
-            Agrif_Gr % tabvars(nb) % root_var   => Agrif_Mygrid % tabvars(nb)
-        enddo
-        do nb = 1, Agrif_NbVariables(1)
-            Agrif_Gr % tabvars_c(nb) % parent_var => Agrif_Gr % parent % tabvars_c(nb)
-            Agrif_Gr % tabvars_c(nb) % nbdim      =  Agrif_Mygrid % tabvars_c(nb) % nbdim
-            Agrif_Gr % tabvars_c(nb) % root_var   => Agrif_Mygrid % tabvars_c(nb)
-        enddo
-        do nb = 1, Agrif_NbVariables(2)
-            Agrif_Gr % tabvars_r(nb) % parent_var => Agrif_Gr % parent % tabvars_r(nb)
-            Agrif_Gr % tabvars_r(nb) % nbdim      =  Agrif_Mygrid % tabvars_r(nb) % nbdim
-            Agrif_Gr % tabvars_r(nb) % root_var   => Agrif_Mygrid % tabvars_r(nb)
-        enddo
-        do nb = 1, Agrif_NbVariables(3)
-            Agrif_Gr % tabvars_l(nb) % parent_var => Agrif_Gr % parent % tabvars_l(nb)
-            Agrif_Gr % tabvars_l(nb) % nbdim      =  Agrif_Mygrid % tabvars_l(nb) % nbdim
-            Agrif_Gr % tabvars_l(nb) % root_var   => Agrif_Mygrid % tabvars_l(nb)
-        enddo
-        do nb = 1, Agrif_NbVariables(4)
-            Agrif_Gr % tabvars_i(nb) % parent_var => Agrif_Gr % parent % tabvars_i(nb)
-            Agrif_Gr % tabvars_i(nb) % nbdim      =  Agrif_Mygrid % tabvars_i(nb) % nbdim
-            Agrif_Gr % tabvars_i(nb) % root_var   => Agrif_Mygrid % tabvars_i(nb)
-        enddo
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Create_Var
-!===================================================================================================
-!
-end module Agrif_Init_Vars
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 10251)
@@ -0,0 +1,2270 @@
+!
+! $Id: modinterp.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Interpolation
+C
+      Module Agrif_Interpolation
+C
+CCC   Description:
+CCC   Module to initialize a fine grid from its parent grid, by using a space 
+CCC   interpolation
+C
+C     Modules used:
+C  
+      Use Agrif_Interpbasic
+      Use Agrif_Arrays
+      Use Agrif_Mask 
+      Use Agrif_CurgridFunctions
+#if defined key_mpp_mpi
+      Use Agrif_mpp
+#endif
+C      
+      IMPLICIT NONE
+      logical,  private:: precomputedone(7) = .FALSE.
+C
+      CONTAINS
+C     Define procedures contained in this module        
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab,
+     &    torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 1D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1)
+     &         ), Target :: tab    ! Result
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C      
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim
+C
+C     Tab is the result of the interpolation
+      childtemp % var % parray1 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray1 = child % var % array1
+C          
+          childtemp % var % restore1D => child % var % restore1D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore1D)
+C      
+      endif     
+C 
+C     Index indicating (in the Agrif_Interp1D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp            
+C      
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_1D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab,
+     &                           torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 2D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2)
+     &    ), Target :: tab    ! Result
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C      
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim
+C
+C     Tab is the result of the interpolation
+      childtemp % var % parray2 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub
+      
+C
+      if (torestore) then      
+C 
+          childtemp % var % parray2 = child % var % array2          
+C 
+          childtemp % var % restore2D => child % var % restore2D        
+C      
+        else
+C        
+          Nullify(childtemp % var % restore2D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp2D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C     
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 3D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &      ), Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C     
+C     Tab is the result of the interpolation 
+      childtemp % var % parray3 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub        
+C      
+      if (torestore) then
+C     
+          childtemp % var % parray3 = child % var % array3
+C
+          childtemp % var % restore3D => child % var % restore3D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore3D)
+C      
+      endif
+C 
+C     Index indicating (in the Agrif_Interp3D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C     
+
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_3D               
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 4D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &      ), Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray4 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C 
+      if (torestore) then
+C 
+          childtemp % var % parray4 = child % var % array4
+C
+          childtemp % var % restore4D => child % var % restore4D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore4D)
+C      
+      endif        
+C 
+C     Index indicating (in the Agrif_Interp4D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade  
+      childtemp % var % list_interp => child % var% list_interp           
+C     
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+      child % var % list_interp => childtemp % var %list_interp
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 5D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &      ),  Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray5 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray5 = child % var % array5
+C
+          childtemp % var % restore5D => child % var % restore5D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore5D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp5D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C      
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+     
+      child % var % list_interp => childtemp % var %list_interp
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_5D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab,
+     &  torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 6D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &      ),  Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray6 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray6 = child % var % array6
+C
+          childtemp % var % restore6D => child % var % restore6D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore6D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp6D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade  
+     
+      childtemp % var % list_interp => child % var% list_interp           
+C      
+
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+C      
+      child % var % list_interp => childtemp % var %list_interp
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_6D
+C
+C
+C
+C     **************************************************************************
+C     Subroutine Agrif_InterpVariable    
+C     **************************************************************************
+C   
+      Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore,
+     &            procname)
+C
+CCC   Description:
+CCC   Subroutine to set some arguments of subroutine Agrif_InterpnD, n being the
+CCC   DIMENSION of the grid variable.
+C
+CC    Declarations:
+C      
+c      
+C      
+C
+C     Scalar argument
+      INTEGER,DIMENSION(6) :: TYPEinterp! TYPE of interpolation
+                                        !    (linear,spline,...)
+C     Data TYPE arguments                                   
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
+C
+C     LOGICAL argument      
+      LOGICAL:: torestore               ! Its value is .false., it indicates the
+                                        ! results of the interpolation are    
+                                        ! applied on the whole current grid   
+C
+C     Local scalars      
+      INTEGER               :: nbdim          ! Number of dimensions of the
+                                              !    current grid
+      INTEGER ,DIMENSION(6) :: pttab_child  
+      INTEGER ,DIMENSION(6) :: petab_child      
+      INTEGER ,DIMENSION(6) :: pttab_parent  
+      REAL    ,DIMENSION(6) :: s_child,s_parent
+      REAL    ,DIMENSION(6) :: ds_child,ds_parent
+      External :: procname
+      Optional ::  procname
+
+C
+      Call PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             nbdim)
+C
+C
+C     Call to a procedure of interpolation against the number of dimensions of 
+C     the grid variable
+C
+
+      if (present(procname)) then
+      call Agrif_InterpnD
+     &            (TYPEinterp,parent,child,
+     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             child,torestore,nbdim,procname)
+      else
+      call Agrif_InterpnD
+     &            (TYPEinterp,parent,child,
+     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             child,torestore,nbdim)
+
+      endif
+C
+      Return
+C
+C
+      End subroutine Agrif_InterpVariable       
+C
+C
+C     **************************************************************************
+C     Subroutine Agrif_InterpnD  
+C     **************************************************************************
+C  
+      Subroutine Agrif_InterpnD(TYPEinterp,parent,child,
+     &                          pttab,petab,
+     &                          pttab_Child,pttab_Parent,
+     &                          s_Child,s_Parent,ds_Child,ds_Parent,
+     &                          restore,torestore,nbdim,procname)
+C
+C     Description:
+C     Subroutine to interpolate a nD grid variable from its parent grid,
+C     by using a space interpolation. 
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+        INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      INTEGER                    :: nbdim
+      INTEGER,DIMENSION(6)       :: TYPEinterp         ! TYPE of interpolation
+                                                       !    (linear,...)
+      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
+                                                       !    grid
+      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
+                                                       !    grid
+      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
+                                                       !    point inside the
+                                                       !    domain
+      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
+                                                       !    point inside the
+                                                       !    domain
+      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
+                                                       !    point inside the
+                                                       !    domain for the child
+                                                       !    grid variable
+      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
+                                                       !    point inside the
+                                                       !    domain for the
+                                                       !    parent grid variable
+      TYPE(AGRIF_PVARIABLE)      :: restore            ! Indicates points where
+                                                       !    interpolation
+      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
+                                                       !    and child grids
+      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
+                                                       !    parent and child
+                                                       !    grids
+      LOGICAL                        :: torestore      ! Indicates if the array
+                                                       !    restore is used
+C
+C     Local pointers
+      TYPE(AGRIF_PVARIABLE),SAVE      :: tempP,tempPextend  ! Temporary parent grid variable
+      TYPE(AGRIF_PVARIABLE),SAVE      :: tempC      ! Temporary child grid variable
+C
+C     Local scalars        
+      INTEGER                     :: i,j,k,l,m,n
+      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
+      LOGICAL,DIMENSION(nbdim)    :: noraftab
+      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
+      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
+      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim,2,2) :: childarray
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: memberin,member
+      TYPE(AGRIF_PVARIABLE),SAVE                      ::  parentvalues
+      LOGICAL :: find_list_interp
+      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2      
+C
+#ifdef key_mpp_mpi
+C
+      LOGICAL :: memberout
+      INTEGER,PARAMETER                          :: etiquette = 100
+      INTEGER                                    :: code
+      INTEGER,DIMENSION(nbdim,4)           :: tab3
+      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+      LOGICAL, DIMENSION(1) :: memberin1
+C
+#endif      
+C     
+
+C   
+C     Boundaries of the current grid where interpolation is done
+
+      IF (Associated(child%var%list_interp)) THEN
+      Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &                          indmin,indmax,indminglob,
+     &       indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &       pttruetab,cetruetab,member,memberin,find_list_interp
+#if defined key_mpp_mpi
+     &       ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+      ELSE
+      find_list_interp = .FALSE.
+      ENDIF
+      
+      IF (.not.find_list_interp) THEN
+
+      Call Agrif_nbdim_Get_bound_dimension(child % var,
+     &                               lowerbound,upperbound,nbdim)
+      
+      Call Agrif_Childbounds(nbdim,lowerbound,upperbound,
+     &                                   pttab,petab,
+     &                                   pttruetab,cetruetab,memberin)
+     
+C
+      Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob,
+     &                        s_Parent_temp,s_Child_temp,
+     &                        s_Child,ds_Child,
+     &                        s_Parent,ds_Parent,
+     &                        pttab,petab,
+     &                        pttab_Child,pttab_Parent,
+     &                        child%var%root_var%posvar,
+     &                        child % var % root_var % interptab)
+       
+#ifdef key_mpp_mpi
+       IF (memberin) THEN
+        Call Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
+     &                        s_Parent_temp,s_Child_temp,
+     &                        s_Child,ds_Child,
+     &                        s_Parent,ds_Parent,
+     &                        pttruetab,cetruetab,
+     &                        pttab_Child,pttab_Parent,
+     &                        child%var%root_var%posvar,
+     &                        child % var % root_var % interptab)
+      ENDIF
+       
+      Call Agrif_nbdim_Get_bound_dimension(parent%var,
+     &                              lowerbound,upperbound,nbdim)
+       
+      Call Agrif_ChildGrid_to_ParentGrid()
+C
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       indminglob,indmaxglob,
+     &                       indminglob2,indmaxglob2,member)
+
+C
+      IF (member) THEN
+      Call Agrif_GlobtoLocInd2(parentarray,
+     &                     lowerbound,upperbound,
+     &                     indminglob2,indmaxglob2,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+       endif
+       
+      Call Agrif_ParentGrid_to_ChildGrid()
+#else
+      parentarray(:,1,1) = indminglob
+      parentarray(:,2,1) = indmaxglob
+      parentarray(:,1,2) = indminglob
+      parentarray(:,2,2) = indmaxglob
+      indmin = indminglob
+      indmax = indmaxglob
+      member = .TRUE.
+#endif
+
+      ELSE
+      
+#if !defined key_mpp_mpi
+      parentarray(:,1,1) = indminglob
+      parentarray(:,2,1) = indmaxglob
+      parentarray(:,1,2) = indminglob
+      parentarray(:,2,2) = indmaxglob
+      indmin = indminglob
+      indmax = indmaxglob
+      member = .TRUE.
+      s_Parent_temp = s_Parent + (indminglob - pttab_Parent)*ds_Parent
+      s_Child_temp = s_Child + (pttab - pttab_Child) * ds_Child
+#else      
+      s_Parent_temp = s_Parent + (indmin - pttab_Parent)*ds_Parent
+      s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
+#endif      
+           
+      ENDIF
+
+      IF (member) THEN
+      IF (.not.associated(tempP%var)) allocate(tempP%var)
+
+C
+      Call Agrif_nbdim_allocation(tempP%var,
+     &     parentarray(:,1,1),parentarray(:,2,1),nbdim)
+
+      Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim)
+
+      IF (present(procname)) THEN
+      Call Agrif_ChildGrid_to_ParentGrid()
+            SELECT CASE (nbdim)
+        CASE(1)
+          CALL procname(tempP%var%array1,
+     &                          parentarray(1,1,2),parentarray(1,2,2))
+        CASE(2)
+          CALL procname(tempP%var%array2,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2))
+        CASE(3)
+          CALL procname(tempP%var%array3,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2))
+        CASE(4)
+          CALL procname(tempP%var%array4,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2))
+        CASE(5)
+          CALL procname(tempP%var%array5,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2),
+     &                          parentarray(5,1,2),parentarray(5,2,2))
+        CASE(6)
+          CALL procname(tempP%var%array6,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2),
+     &                          parentarray(5,1,2),parentarray(5,2,2),
+     &                          parentarray(6,1,2),parentarray(6,2,2))
+            END SELECT
+      Call Agrif_ParentGrid_to_ChildGrid()
+      ELSE
+
+      Call Agrif_nbdim_VarEQvar(tempP%var,
+     &        parentarray(:,1,1),parentarray(:,2,1),
+     &        parent%var,parentarray(:,1,2),parentarray(:,2,2),
+     &        nbdim)
+      ENDIF
+            endif
+
+#ifdef key_mpp_mpi
+      if (.not.find_list_interp) then
+      tab3(:,1) = indminglob2(:)
+      tab3(:,2) = indmaxglob2(:)
+      tab3(:,3) = indmin(:)
+      tab3(:,4) = indmax(:)
+C
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
+
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+      enddo
+      enddo
+      
+      memberin1(1) = memberin
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+
+       Call Get_External_Data_first(tab4t(:,:,1),
+     &            tab4t(:,:,2),
+     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
+     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
+     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+          
+      endif     
+           
+!      Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1),
+!     &            tab4t(:,:,2),
+!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
+!     &            memberinall)
+     
+      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
+     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
+     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,
+     &            tempPextend)
+#else
+      tempPextend%var => tempP%var
+#endif
+
+      if (.not.find_list_interp) then
+      Call Agrif_Addto_list_interp(child%var%list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,indmin,indmax,
+     &   indminglob,indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &   pttruetab,cetruetab,member,memberin,nbdim
+#if defined key_mpp_mpi
+     &   ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+      endif   
+C
+C
+      IF (memberin) THEN
+      IF (.not.associated(tempC%var)) allocate(tempC%var)
+C
+
+      Call Agrif_nbdim_allocation(tempC%var,pttruetab,cetruetab,nbdim)
+
+C
+C
+C     Special values on the parent grid
+      if (Agrif_UseSpecialValue) then
+C
+          noraftab(1:nbdim) =
+     &         child % var % root_var % interptab(1:nbdim) .EQ. 'N'
+C
+          IF (.not.associated(parentvalues%var))
+     &            Allocate(parentvalues%var)
+C
+          Call Agrif_nbdim_allocation
+     &               (parentvalues%var,indmin,indmax,nbdim)
+          Call Agrif_nbdim_Full_VarEQvar
+     &               (parentvalues%var,tempPextend%var,nbdim)
+C
+          Call Agrif_CheckMasknD(tempPextend,
+     &                           parentvalues,
+     &                           indmin(1:nbdim),indmax(1:nbdim),
+     &                           indmin(1:nbdim),indmax(1:nbdim),
+     &                           noraftab(1:nbdim),nbdim)
+C
+          Call Agrif_nbdim_deallocation(parentvalues%var,nbdim)
+C          Deallocate(parentvalues%var)
+C
+C
+      endif      
+
+C
+C
+C     Interpolation of the current grid
+
+      IF (memberin) THEN
+      if ( nbdim .EQ. 1 ) then
+         Call Agrif_Interp_1D_recursive(TypeInterp,
+     &           tempPextend%var%array1,tempC%var%array1,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 2 ) then
+
+         Call Agrif_Interp_2D_recursive(TypeInterp,
+     &           tempPextend%var%array2,tempC%var%array2,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 3 ) then
+
+         Call Agrif_Interp_3D_recursive(TypeInterp,
+     &           tempPextend%var%array3,tempC%var%array3,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 4 ) then
+         Call Agrif_Interp_4D_recursive(TypeInterp,
+     &           tempPextend%var%array4,tempC%var%array4,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 5 ) then
+         Call Agrif_Interp_5D_recursive(TypeInterp,
+     &           tempPextend%var%array5,tempC%var%array5,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 6 ) then
+         Call Agrif_Interp_6D_recursive(TypeInterp,
+     &           tempPextend%var%array6,tempC%var%array6,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+       endif
+
+
+C  
+
+      Call Agrif_nbdim_Get_bound_dimension(child % var,
+     &                               lowerbound,upperbound,nbdim)
+
+#ifdef key_mpp_mpi
+      Call Agrif_GlobtoLocInd2(childarray,
+     &                     lowerbound,upperbound,
+     &                     pttruetab,cetruetab,
+     &                     nbdim,Agrif_Procrank,
+     &                     memberout)
+
+#else
+       childarray(:,1,1) = pttruetab
+       childarray(:,2,1) = cetruetab
+       childarray(:,1,2) = pttruetab
+       childarray(:,2,2) = cetruetab
+ccccccccccccccc       memberout = .TRUE.
+#endif
+
+
+C
+C
+C     Special values on the child grid  
+      if (Agrif_UseSpecialValueFineGrid) then
+C
+
+          Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var,
+     &                 childarray,
+     &                 pttruetab,cetruetab,
+     &                 Agrif_SpecialValueFineGrid,nbdim)
+
+C        
+      endif
+      
+      endif
+
+C
+      if (torestore) then
+C
+#ifdef key_mpp_mpi
+C
+        SELECT CASE (nbdim)
+        CASE (1)
+             do i = pttruetab(1),cetruetab(1)         
+ChildarrayAModifier                if (restore%var%restore1D(i) == 0) 
+ChildarrayAModifier     &                child%var%array1(childarray(i,1,2)
+ChildarrayAModifier     &                                 ) = 
+ChildarrayAModifier     &                tempC%var%array1(i)
+             enddo
+        CASE (2)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+ChildarrayAModifier                   if (restore%var%restore2D(i,j) == 0) 
+ChildarrayAModifier     &                child%var%array2(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2)) = 
+ChildarrayAModifier     &                tempC%var%array2(i,j)
+             enddo
+             enddo
+        CASE (3)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)  
+             do k = pttruetab(3),cetruetab(3)
+ChildarrayAModifier                      if (restore%var%restore3D(i,j,k) == 0) 
+ChildarrayAModifier     &                child%var%array3(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2)) = 
+ChildarrayAModifier     &                tempC%var%array3(i,j,k)
+             enddo
+             enddo
+             enddo
+        CASE (4)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+ChildarrayAModifier                         if (restore%var%restore4D(i,j,k,l) == 0) 
+ChildarrayAModifier     &                      child%var%array4(childarray(i,1,2),
+ChildarrayAModifier     &                                       childarray(j,2,2),
+ChildarrayAModifier     &                                       childarray(k,3,2),
+ChildarrayAModifier     &                                       childarray(l,4,2)) = 
+ChildarrayAModifier     &                      tempC%var%array4(i,j,k,l)
+             enddo
+             enddo
+             enddo
+             enddo
+        CASE (5)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+             do m = pttruetab(5),cetruetab(5)
+ChildarrayAModifier              if (restore%var%restore5D(i,j,k,l,m) == 0) 
+ChildarrayAModifier     &                child%var%array5(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2),
+ChildarrayAModifier     &                                 childarray(l,4,2),
+ChildarrayAModifier     &                                 childarray(m,5,2)) = 
+ChildarrayAModifier     &                tempC%var%array5(i,j,k,l,m)
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+        CASE (6)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+             do m = pttruetab(5),cetruetab(5)
+             do n = pttruetab(6),cetruetab(6)
+ChildarrayAModifier              if (restore%var%restore6D(i,j,k,l,m,n) == 0) 
+ChildarrayAModifier     &                child%var%array6(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2),
+ChildarrayAModifier     &                                 childarray(l,4,2),
+ChildarrayAModifier     &                                 childarray(m,5,2),
+ChildarrayAModifier     &                                 childarray(n,6,2)) = 
+ChildarrayAModifier     &                tempC%var%array6(i,j,k,l,m,n)
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+        END SELECT
+C
+#else
+        SELECT CASE (nbdim)
+        CASE (1)
+           do i = pttruetab(1),cetruetab(1)         
+            if (restore%var%restore1D(i) == 0)
+     &            child % var % parray1(i) = 
+     &            tempC % var % array1(i)    
+          enddo
+        CASE (2)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1) 
+              if (restore%var%restore2D(i,j) == 0)     
+     &              child % var % parray2(i,j) = 
+     &              tempC % var % array2(i,j)    
+              enddo
+             enddo
+        CASE (3)
+           do k = pttruetab(3),cetruetab(3)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1) 
+              if (restore%var%restore3D(i,j,k) == 0)
+     &                  child % var % parray3(i,j,k) =
+     &                  tempC % var % array3(i,j,k)    
+                  enddo
+              enddo
+             enddo
+        CASE (4)
+           do l = pttruetab(4),cetruetab(4)
+           do k = pttruetab(3),cetruetab(3)
+          do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore4D(i,j,k,l) == 0)
+     &                 child % var % parray4(i,j,k,l) = 
+     &                 tempC % var % array4(i,j,k,l)    
+             enddo
+             enddo
+              enddo
+             enddo
+        CASE (5)
+           do m = pttruetab(5),cetruetab(5)
+          do l = pttruetab(4),cetruetab(4)
+         do k = pttruetab(3),cetruetab(3)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore5D(i,j,k,l,m) == 0)
+     &                  child % var % parray5(i,j,k,l,m) = 
+     &                  tempC % var % array5(i,j,k,l,m)    
+             enddo
+             enddo
+                  enddo
+              enddo
+             enddo
+        CASE (6)
+           do n = pttruetab(6),cetruetab(6)
+          do m = pttruetab(5),cetruetab(5)
+          do l = pttruetab(4),cetruetab(4)
+         do k = pttruetab(3),cetruetab(3)
+          do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore6D(i,j,k,l,m,n) == 0)
+     &                      child % var % parray6(i,j,k,l,m,n) = 
+     &                      tempC % var % array6(i,j,k,l,m,n)    
+             enddo
+            enddo
+                      enddo
+                  enddo
+              enddo
+             enddo
+        END SELECT
+C
+#endif
+C        
+        else
+C
+C
+          IF (memberin) THEN
+          SELECT CASE (nbdim)
+          CASE (1)
+            child%var%parray1(childarray(1,1,2):childarray(1,2,2)) =
+     &       tempC%var%array1(childarray(1,1,1):childarray(1,2,1))
+          CASE (2)
+            child%var%parray2(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2)) =
+     &      tempC%var%array2(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1))
+          CASE (3)
+            child%var%parray3(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2)) =
+     &      tempC%var%array3(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1))
+          CASE (4)
+            child%var%parray4(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2)) =
+     &      tempC%var%array4(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1))
+          CASE (5)
+            child%var%parray5(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2),
+     &                       childarray(5,1,2):childarray(5,2,2)) =
+     &      tempC%var%array5(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1),
+     &                       childarray(5,1,1):childarray(5,2,1))
+          CASE (6)
+            child%var%parray6(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2),
+     &                       childarray(5,1,2):childarray(5,2,2),
+     &                       childarray(6,1,2):childarray(6,2,2)) =
+     &      tempC%var%array6(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1),
+     &                       childarray(5,1,1):childarray(5,2,1),
+     &                       childarray(6,1,1):childarray(6,2,1))
+          END SELECT
+          ENDIF
+C
+C       
+      endif
+
+        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
+C        deallocate(tempPextend%var)
+
+      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
+      
+C      Deallocate(tempC % var)
+      ELSE
+      
+C      deallocate(tempPextend%var)
+
+      ENDIF
+C
+C             
+C     Deallocations
+#ifdef key_mpp_mpi        
+      IF (member) THEN
+      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
+C      Deallocate(tempP % var)
+      endif
+#endif
+C
+C
+      
+C
+C
+      End Subroutine Agrif_InterpnD 
+C
+C
+C
+C                  
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Parentbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
+     &                              s_Parent_temp,
+     &                              s_Child_temp,s_Child,ds_Child,
+     &                              s_Parent,ds_Parent,
+     &                              pttruetab,cetruetab,pttab_Child,
+     &                              pttab_Parent,posvar,interptab)
+C
+CCC   Description:
+CCC   Subroutine calculating the bounds of the parent grid for the interpolation
+CCC   of the child grid     
+C
+C
+C     Declarations:
+C
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER, DIMENSION(6) :: TypeInterp
+      INTEGER,DIMENSION(nbdim) :: indmin,indmax
+      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
+      REAL,DIMENSION(nbdim) :: s_Child,ds_child
+      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
+      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim) :: posvar
+      CHARACTER(6), DIMENSION(nbdim) :: interptab
+C
+C     Local variables
+      INTEGER :: i
+      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
+C
+      dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
+      dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
+      
+      DO i = 1,nbdim         
+C     
+        indmin(i) = pttab_Parent(i) + 
+     &         agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+C
+        indmax(i) = pttab_Parent(i) + 
+     &                agrif_ceiling((dim_newmax(i)-
+     &                s_Parent(i))/ds_Parent(i))
+     
+C
+C
+C       Necessary for the Quadratic interpolation
+C  
+
+        IF ((pttruetab(i) == cetruetab(i)) .AND. 
+     &                           (posvar(i) == 1)) THEN
+        ELSEIF (interptab(i) .EQ. 'N') THEN
+        ELSEIF ( TYPEinterp(i) .eq. Agrif_ppm .or.
+     &      TYPEinterp(i) .eq. Agrif_eno  .or.
+     &      TYPEinterp(i) .eq. Agrif_weno) THEN            
+           indmin(i) = indmin(i) - 2  
+           indmax(i) = indmax(i) + 2                  
+        ELSE IF (( TYPEinterp(i) .ne. Agrif_constant )
+     &        .AND.( TYPEinterp(i) .ne. Agrif_linear )) THEN
+           indmin(i) = indmin(i) - 1  
+           indmax(i) = indmax(i) + 1
+        ENDIF
+        
+
+C        
+       ENDDO 
+C
+        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+C     
+        s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
+C
+C
+      Return
+C
+C
+      End Subroutine Agrif_Parentbounds
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_1D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_1D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax, 
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)     
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 1D grid variable. 
+CCC   It calls Agrif_InterpBase. 
+C
+C     Declarations:
+C
+      
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(1) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent
+      REAL, DIMENSION(nbdim) :: ds_child,ds_parent
+      REAL, INTENT(IN),DIMENSION(indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL, INTENT(OUT),
+     &      DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tabout
+      INTEGER :: coeffraf
+C
+C
+C     Commentaire perso : nbdim vaut toujours 1 ici. 
+C
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      Call Agrif_InterpBase(TypeInterp(1),
+     &                  tabin(indmin(nbdim):indmax(nbdim)),
+     &                  tabout(pttab_child(nbdim):petab_child(nbdim)),
+     &                  indmin(nbdim),indmax(nbdim),            
+     &                  pttab_child(nbdim),petab_child(nbdim),
+     &                  s_parent(nbdim),s_child(nbdim),
+     &                  ds_parent(nbdim),ds_child(nbdim),coeffraf)
+                
+C                
+      Return
+C
+C
+      End Subroutine Agrif_Interp_1D_recursive
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_2D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_2D_recursive(TypeInterp,
+     &           tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &            s_child, s_parent,
+     &           ds_child,ds_parent,
+     &           nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 2D grid variable. 
+CCC   It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER,DIMENSION(2)      :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL   , DIMENSION(nbdim) ::  s_child, s_parent
+      REAL   , DIMENSION(nbdim) :: ds_child,ds_parent
+      REAL   ,INTENT(IN), DIMENSION(
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)
+     &                ) :: tabin        
+      REAL   ,INTENT(OUT), DIMENSION(
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)
+     &                ) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j
+      INTEGER :: coeffraf
+      REAL   , DIMENSION(
+     &                pttab_child(nbdim):petab_child(nbdim),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1)
+     &                ) :: tabout_trsp
+      REAL, DIMENSION(indmin(nbdim):indmax(nbdim),
+     &        pttab_child(nbdim-1):petab_child(nbdim-1)) :: tabtemp_trsp
+
+C
+C
+C
+C
+C     Commentaire perso : nbdim vaut toujours 2 ici.
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(1) ) call linear1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,   
+     &          indmax(1)-indmin(1)+1,   
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+           call linear1daftercompute(tabin,tabtemp,
+     &          size(tabin), size(tabtemp),  
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+ 
+      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(1) ) call ppm1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,   
+     &          indmax(1)-indmin(1)+1,   
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+           call ppm1daftercompute(tabin,tabtemp,
+     &          size(tabin), size(tabtemp),  
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+
+      ELSE
+
+      do j = indmin(nbdim),indmax(nbdim)
+C        
+!---CDIR NEXPAND
+        Call Agrif_Interp_1D_recursive(TypeInterp(1),
+     &         tabin(indmin(nbdim-1):indmax(nbdim-1),j),
+     &         tabtemp(pttab_child(nbdim-1):petab_child(nbdim-1),j),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      ENDIF   
+
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      tabtemp_trsp = TRANSPOSE(tabtemp)
+
+      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(2) ) call linear1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+           call linear1daftercompute(tabtemp_trsp,tabout_trsp,
+     &          size(tabtemp_trsp), size(tabout_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+           IF(.NOT. precomputedone(1) )call ppm1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+           call ppm1daftercompute(tabtemp_trsp,tabout_trsp,
+     &          size(tabtemp_trsp), size(tabout_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSE
+      do i=pttab_child(nbdim-1),petab_child(nbdim-1)
+C
+!---CDIR NEXPAND
+        Call Agrif_InterpBase(TypeInterp(2),
+     &           tabtemp_trsp(indmin(nbdim):indmax(nbdim),i),
+     &           tabout_trsp(pttab_child(nbdim):petab_child(nbdim),i),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+
+C        
+      enddo
+      ENDIF
+      
+      tabout = TRANSPOSE(tabout_trsp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Interp_2D_recursive
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_3D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_3D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 3D grid variable. 
+CCC   It calls Agrif_Interp_2D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(3) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim)  :indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &        DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k
+      INTEGER :: coeffraf, locind_child_left, kdeb
+C
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf/=1))THEN 
+        Call linear1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,
+     &          indmax(1)-indmin(1)+1,
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE. 
+      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf/=1))THEN
+        Call ppm1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,
+     &          indmax(1)-indmin(1)+1,
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ENDIF
+
+      coeffraf = nint ( ds_parent(2) / ds_child(2) )
+      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf/=1)) THEN
+         Call linear1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE. 
+      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf/=1)) THEN
+         Call ppm1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ENDIF
+
+      do k = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_2D_recursive(TypeInterp(1:2),
+     &         tabin(indmin(nbdim-2):indmax(nbdim-2),
+     &         indmin(nbdim-1):indmax(nbdim-1),k),
+     &         tabtemp(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &         pttab_child(nbdim-1):petab_child(nbdim-1),k),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      precomputedone(1) = .FALSE.
+      precomputedone(2) = .FALSE.
+      coeffraf = nint ( ds_parent(3) / ds_child(3) )
+
+      Call Agrif_Compute_nbdim_interp(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+           
+      IF (coeffraf == 1) THEN
+      
+      kdeb = indmin(3)+locind_child_left-2
+      do k=pttab_child(3),petab_child(3)
+      kdeb = kdeb + 1
+      do j = pttab_child(2),petab_child(2)
+        do i = pttab_child(1),petab_child(1)
+        tabout(i,j,k) = tabtemp(i,j,kdeb)
+      enddo
+      enddo
+      enddo
+              
+      ELSE      
+C
+      do j=pttab_child(nbdim-1),petab_child(nbdim-1) 
+C        
+        do i=pttab_child(nbdim-2),petab_child(nbdim-2)
+C
+          Call Agrif_InterpBase(TypeInterp(3),
+     &           tabtemp(i,j,indmin(nbdim):indmax(nbdim)),
+     &           tabout(i,j,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+        enddo 
+C       
+      enddo
+      ENDIF
+C
+      Return
+C        
+C
+      End Subroutine Agrif_Interp_3D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_4D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_4D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 4D grid variable. 
+CCC   It calls Agrif_Interp_3D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(4) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-3):indmax(nbdim-3),
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &       DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),  
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l
+      INTEGER :: coeffraf
+C
+C
+      do l = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_3D_recursive(TypeInterp(1:3),
+     &         tabin(indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),l),
+     &         tabtemp(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &         pttab_child(nbdim-2):petab_child(nbdim-2),
+     &         pttab_child(nbdim-1):petab_child(nbdim-1),l),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+C
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      do k = pttab_child(nbdim-1),petab_child(nbdim-1)
+C
+        do j = pttab_child(nbdim-2),petab_child(nbdim-2) 
+C        
+          do i = pttab_child(nbdim-3),petab_child(nbdim-3)
+C
+            Call Agrif_InterpBase(TypeInterp(4),
+     &           tabtemp(i,j,k,indmin(nbdim):indmax(nbdim)),
+     &           tabout(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_4D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_5D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_5D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 5D grid variable. 
+CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(5) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-4):indmax(nbdim-4),
+     &                indmin(nbdim-3):indmax(nbdim-3),
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin  
+      REAL,INTENT(OUT),
+     &    DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l,m
+      INTEGER :: coeffraf
+C
+C
+      do m = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_4D_recursive(TypeInterp(1:4),
+     &         tabin(indmin(nbdim-4):indmax(nbdim-4),
+     &               indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),m),
+     &         tabtemp(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),m),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+C
+      do l = pttab_child(nbdim-1),petab_child(nbdim-1) 
+C
+        do k = pttab_child(nbdim-2),petab_child(nbdim-2)
+C
+          do j = pttab_child(nbdim-3),petab_child(nbdim-3) 
+C        
+            do i = pttab_child(nbdim-4),petab_child(nbdim-4)
+C
+              Call Agrif_InterpBase(TypeInterp(5),
+     &             tabtemp(i,j,k,l,indmin(nbdim):indmax(nbdim)),
+     &                    tabout(i,j,k,l,
+     &             pttab_child(nbdim):petab_child(nbdim)),
+     &             indmin(nbdim),indmax(nbdim),
+     &             pttab_child(nbdim),petab_child(nbdim),
+     &             s_parent(nbdim),s_child(nbdim),
+     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+            enddo
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+C
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_5D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_6D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_6D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 6D grid variable. 
+CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-5):indmax(nbdim-5),
+     &                indmin(nbdim-4):indmax(nbdim-4),
+     &                indmin(nbdim-3):indmax(nbdim-3), 
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &    DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),    
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l,m,n
+      INTEGER :: coeffraf
+C
+C        
+C
+      do n = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_5D_recursive(TypeInterp(1:5),
+     &         tabin(indmin(nbdim-5):indmax(nbdim-5),
+     &               indmin(nbdim-4):indmax(nbdim-4),
+     &               indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),n),
+     &         tabtemp(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),n),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+C
+      do m = pttab_child(nbdim-1),petab_child(nbdim-1) 
+      do l = pttab_child(nbdim-2),petab_child(nbdim-2) 
+C
+        do k = pttab_child(nbdim-3),petab_child(nbdim-3)
+C
+          do j = pttab_child(nbdim-4),petab_child(nbdim-4) 
+C        
+            do i = pttab_child(nbdim-5),petab_child(nbdim-5)
+C
+              Call Agrif_InterpBase(TypeInterp(6),
+     &             tabtemp(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
+     &                    tabout(i,j,k,l,m,
+     &                    pttab_child(nbdim):petab_child(nbdim)),
+     &             indmin(nbdim),indmax(nbdim),
+     &             pttab_child(nbdim),petab_child(nbdim),
+     &             s_parent(nbdim),s_child(nbdim),
+     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+            enddo
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+      enddo
+C                
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_6D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpBase  
+C     **************************************************************************
+C  
+      Subroutine Agrif_InterpBase(TypeInterp,
+     &                           parenttab,childtab,
+     &                           indmin,indmax,pttab_child,petab_child,
+     &                           s_parent,s_child,ds_parent,ds_child,
+     &                           coeffraf)   
+C
+CCC   Description:
+CCC   Subroutine calling the interpolation method chosen by the user (linear, 
+CCC   lagrange or spline). 
+C
+C     Declarations:
+C
+      
+C
+      INTEGER                :: TypeInterp
+      INTEGER :: indmin,indmax
+      INTEGER :: pttab_child,petab_child
+      REAL,INTENT(IN),DIMENSION(indmin:indmax)           :: parenttab       
+      REAL,INTENT(OUT),DIMENSION(pttab_child:petab_child) :: childtab        
+      REAL    :: s_parent,s_child,ds_parent,ds_child 
+      INTEGER :: coeffraf
+C 
+C
+       IF ((indmin == indmax).AND.(pttab_child == petab_child)) THEN
+         childtab(pttab_child) = parenttab(indmin)
+       ELSEIF (TYPEinterp .EQ. AGRIF_LINEAR) then    
+C
+C         Linear interpolation 
+  
+          Call linear1D
+     &         (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child)
+C          
+      elseif ( TYPEinterp .EQ. AGRIF_PPM ) then
+
+          Call ppm1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C
+
+        elseif (TYPEinterp .EQ. AGRIF_LAGRANGE) then
+C          
+C         Lagrange interpolation    
+          Call lagrange1D
+     &        (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C            
+        elseif (TYPEinterp .EQ. AGRIF_ENO) then
+C          
+C         Eno interpolation
+          Call eno1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C        
+        elseif (TYPEinterp .EQ. AGRIF_WENO) then
+C          
+C         Eno interpolation
+          Call weno1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C            
+        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERV) then
+C          
+C         Linear conservative interpolation
+          
+          Call linear1Dconserv
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)   
+C              
+        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERVLIM) then
+C          
+C         Linear conservative interpolation
+          
+          Call linear1Dconservlim
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)         
+C              
+        elseif (TYPEinterp .EQ. AGRIF_CONSTANT) then
+C          
+          Call constant1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C              
+      endif 
+C
+C      
+      End Subroutine Agrif_InterpBase 
+C
+
+      Subroutine Agrif_Compute_nbdim_interp(s_parent,s_child,
+     &  ds_parent,ds_child,coeffraf,locind_child_left)
+      real :: s_parent,s_child,ds_parent,ds_child
+      integer :: coeffraf,locind_child_left
+     
+      coeffraf = nint(ds_parent/ds_child)
+      locind_child_left = 1 + agrif_int((s_child-s_parent)/ds_parent)
+      End Subroutine Agrif_Compute_nbdim_interp
+C          
+
+      Subroutine Agrif_Find_list_interp(list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &                          indmin,indmax,indminglob,
+     &      indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &       pttruetab,cetruetab,member,memberin,
+     &      find_list_interp
+#if defined key_mpp_mpi
+     &     ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )     
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      LOGICAL :: find_list_interp
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+      INTEGER,DIMENSION(nbdim)   :: indmin,indmax  
+      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab      
+      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2  
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: member, memberin
+      INTEGER :: i
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+#endif 
+                    
+      find_list_interp = .FALSE.
+      
+      parcours => list_interp
+      Find_loop :   Do While (associated(parcours))
+        Do i=1,nbdim
+          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
+     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
+     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
+     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
+     &               THEN
+            parcours=>parcours%suiv
+            Cycle Find_loop
+          ENDIF
+        EndDo
+
+        indmin = parcours%interp_loc%indmin(1:nbdim)
+        indmax = parcours%interp_loc%indmax(1:nbdim)
+        
+        pttruetab = parcours%interp_loc%pttruetab(1:nbdim)
+        cetruetab = parcours%interp_loc%cetruetab(1:nbdim)
+                
+#if !defined key_mpp_mpi
+        indminglob = parcours%interp_loc%indminglob(1:nbdim)
+        indmaxglob = parcours%interp_loc%indmaxglob(1:nbdim)
+#else
+        indminglob2 = parcours%interp_loc%indminglob2(1:nbdim)
+        indmaxglob2 = parcours%interp_loc%indmaxglob2(1:nbdim)
+        parentarray = parcours%interp_loc%parentarray(1:nbdim,:,:)
+        member = parcours%interp_loc%member
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        sendtoproc1 = parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
+        recvfromproc1 = 
+     &    parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
+#endif        
+        memberin = parcours%interp_loc%memberin
+        find_list_interp = .TRUE.   
+        Exit Find_loop
+      End Do Find_loop  
+                              
+      End Subroutine Agrif_Find_list_interp   
+      
+      Subroutine Agrif_AddTo_list_interp(list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,indmin,indmax,
+     &                          indminglob,indmaxglob,
+     &                          indminglob2,indmaxglob2,
+     &                          parentarray,pttruetab,cetruetab,
+     &                          member,memberin,nbdim
+#if defined key_mpp_mpi
+     &      ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+          
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim)   :: indmin,indmax
+      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2
+      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: member, memberin
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc1
+#endif                   
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+            
+       Allocate(parcours)
+      Allocate(parcours%interp_loc)
+      
+      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
+      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+  
+  
+      parcours%interp_loc%indmin(1:nbdim) = indmin(1:nbdim)
+      parcours%interp_loc%indmax(1:nbdim) = indmax(1:nbdim)
+
+      parcours%interp_loc%memberin = memberin
+#if !defined key_mpp_mpi
+      parcours%interp_loc%indminglob(1:nbdim) = indminglob(1:nbdim)
+      parcours%interp_loc%indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
+#else
+      parcours%interp_loc%indminglob2(1:nbdim) = indminglob2(1:nbdim)
+      parcours%interp_loc%indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
+      parcours%interp_loc%parentarray(1:nbdim,:,:) 
+     &       = parentarray(1:nbdim,:,:)
+      parcours%interp_loc%member = member
+      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))                  
+      parcours%interp_loc%tab4t=tab4t   
+      parcours%interp_loc%memberinall=memberinall   
+      parcours%interp_loc%sendtoproc1=sendtoproc1
+      parcours%interp_loc%recvfromproc1=recvfromproc1            
+#endif      
+
+      parcours%interp_loc%pttruetab(1:nbdim) = pttruetab(1:nbdim)
+      parcours%interp_loc%cetruetab(1:nbdim) = cetruetab(1:nbdim)
+      
+      parcours%suiv => list_interp
+      
+      list_interp => parcours
+      End Subroutine Agrif_Addto_list_interp 
+                
+      End Module Agrif_Interpolation
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 10250)
+++ 	(revision )
@@ -1,1507 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module to initialize a fine grid from its parent grid, by using a space interpolation
-!
-module Agrif_Interpolation
-!
-    use Agrif_InterpBasic
-    use Agrif_Arrays
-    use Agrif_Mask
-    use Agrif_CurgridFunctions
-#if defined AGRIF_MPI
-    use Agrif_Mpp
-#endif
-!
-    implicit none
-!
-    logical, private:: precomputedone(7) = .FALSE.
-!
-    private :: Agrif_Parentbounds
-    private :: Agrif_Interp_1D_recursive, Agrif_Interp_2D_recursive, Agrif_Interp_3D_recursive
-    private :: Agrif_Interp_4D_recursive, Agrif_Interp_5D_recursive, Agrif_Interp_6D_recursive
-    private :: Agrif_InterpBase
-    private :: Agrif_Find_list_interp, Agrif_AddTo_list_interp
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_InterpVariable
-!
-!> Sets some arguments of subroutine Agrif_InterpnD, n being the dimension of the grid variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpVariable ( parent, child, torestore, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
-    type(Agrif_Variable), pointer       :: child        !< Variable on the child grid
-    logical,              intent(in)    :: torestore    !< .false. indicates that the results of the
-                                                        !! interpolation are applied on the whole current grid
-    procedure()                         :: procname     !< Data recovery procedure
-!---------------------------------------------------------------------------------------------------
-    logical               :: memberin
-    integer               :: nbdim        ! Number of dimensions of the current grid
-    integer, dimension(6) :: type_interp  ! Type of interpolation (linear,spline,...)
-    integer, dimension(6) :: nb_child
-    integer, dimension(6) :: lb_child
-    integer, dimension(6) :: ub_child
-    integer, dimension(6) :: lb_parent
-    real   , dimension(6) :: s_child,   s_parent
-    real   , dimension(6) :: ds_child, ds_parent
-    integer, dimension(child % root_var % nbdim,2,2) :: childarray
-!
-    nbdim       = child % root_var % nbdim
-    type_interp = child % root_var % type_interp
-!
-    call PreProcessToInterpOrUpdate( parent,   child,       &
-                                     nb_child, ub_child,    &
-                                     lb_child, lb_parent,   &
-                                      s_child,  s_parent,   &
-                                     ds_child, ds_parent, nbdim, interp=.true.)
-!
-!   Call to a procedure of interpolation against the number of dimensions of the grid variable
-!
-    call Agrif_InterpnD(type_interp, parent, child, &
-                        lb_child, ub_child,         &
-                        lb_child, lb_parent,        &
-                        s_child,   s_parent,        &
-                        ds_child, ds_parent,        &
-                        child, torestore, nbdim,    &
-                        childarray, memberin,       &
-                        .false., procname, 0, 0)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpVariable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_InterpnD
-!
-!> Interpolates a nD grid variable from its parent grid, by using a space interpolation
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpnD ( type_interp, parent, child, pttab, petab, pttab_Child, pttab_Parent, &
-                            s_Child, s_Parent, ds_Child, ds_Parent, restore, torestore,          &
-                            nbdim, childarray, memberin, in_bc, procname, nb, ndir )
-!---------------------------------------------------------------------------------------------------
-#if defined AGRIF_MPI
-    include 'mpif.h'
-#endif
-!
-    INTEGER, DIMENSION(6),     INTENT(in)   :: type_interp  !< Type of interpolation !    (linear,...)
-    TYPE(Agrif_Variable),      pointer      :: parent       !< Variable of the parent grid
-    TYPE(Agrif_Variable),      pointer      :: child        !< Variable of the child grid
-    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab        !< Index of the first point inside the domain
-    INTEGER, DIMENSION(nbdim), INTENT(in)   :: petab        !< Index of the first point inside the domain
-    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Child  !< Index of the first point inside the domain
-                                                            !<    for the child grid variable
-    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Parent !< Index of the first point inside the domain
-                                                            !<    for the parent grid variable
-    REAL,    DIMENSION(nbdim), INTENT(in)   :: s_Child,s_Parent   !< Positions of the parent and child grids
-    REAL,    DIMENSION(nbdim), INTENT(in)   :: ds_Child,ds_Parent !< Space steps of the parent and child grids
-    TYPE(Agrif_Variable),      pointer      :: restore            !< Indicates points where interpolation
-    LOGICAL,                   INTENT(in)   :: torestore          !< Indicates if the array restore is used
-    INTEGER,                   INTENT(in)   :: nbdim
-    LOGICAL,                   INTENT(out)  :: memberin
-    LOGICAL,                   INTENT(in)   :: in_bc              !< .true. if called from Agrif_CorrectVariable \n
-                                                                  !! .false. if called from Agrif_InterpVariable
-    procedure()                             :: procname           !< Data recovery procedure
-    INTEGER,                   INTENT(in)   :: nb, ndir
-!
-    INTEGER                       :: i,j,k,l,m,n
-    INTEGER, DIMENSION(nbdim)     :: pttruetab,cetruetab
-    INTEGER, DIMENSION(nbdim)     :: indmin,     indmax
-    INTEGER, DIMENSION(nbdim)     :: indminglob, indmaxglob
-#if defined AGRIF_MPI
-    INTEGER, DIMENSION(nbdim)     :: indminglob2,indmaxglob2
-#endif
-    LOGICAL, DIMENSION(nbdim)     :: noraftab
-    REAL   , DIMENSION(nbdim)     :: s_Child_temp,s_Parent_temp
-    INTEGER, DIMENSION(nbdim)     :: lowerbound, upperbound, coords
-    INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray
-    INTEGER, DIMENSION(nbdim,2,2)              :: parentarray
-    LOGICAL :: member
-    LOGICAL :: find_list_interp
-!
-#if defined AGRIF_MPI
-!
-    INTEGER, PARAMETER          :: etiquette = 100
-    INTEGER                     :: code, local_proc
-    INTEGER, DIMENSION(nbdim,4)                     :: tab3
-    INTEGER, DIMENSION(nbdim,4,0:Agrif_Nbprocs-1)   :: tab4
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: memberinall
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: sendtoproc1, recvfromproc1
-    LOGICAL, DIMENSION(1)                           :: memberin1
-    LOGICAL                                         :: memberout
-!
-#endif
-!
-    type(Agrif_Variable), pointer, save :: tempC => NULL()        ! Temporary child grid variable
-    type(Agrif_Variable), pointer, save :: tempP => NULL()        ! Temporary parent grid variable
-    type(Agrif_Variable), pointer, save :: tempPextend => NULL()  ! Temporary parent grid variable
-    type(Agrif_Variable), pointer, save :: parentvalues => NULL()
-!
-    coords = child % root_var % coords
-!
-!   Boundaries of the current grid where interpolation is done
-    find_list_interp =                                              &
-        Agrif_Find_list_interp(                                     &
-            child % list_interp,                                    &
-            pttab, petab, pttab_Child, pttab_Parent, nbdim,         &
-            indmin, indmax, indminglob, indmaxglob,                 &
-            pttruetab, cetruetab, memberin                          &
-#if defined AGRIF_MPI
-           ,indminglob2, indmaxglob2, parentarray,                  &
-            member, tab4t,memberinall,  sendtoproc1, recvfromproc1  &
-#endif
-        )
-!
-    if (.not.find_list_interp) then
-!
-        call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
-        call Agrif_Childbounds(nbdim, lowerbound, upperbound,               &
-                               pttab, petab, Agrif_Procrank, coords,        &
-                               pttruetab, cetruetab, memberin)
-        call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob,    &
-                                s_Parent_temp,s_Child_temp,                 &
-                                s_Child,ds_Child,                           &
-                                s_Parent,ds_Parent,                         &
-                                pttab,petab,                                &
-                                pttab_Child,pttab_Parent,                   &
-                                child%root_var % posvar, coords)
-#if defined AGRIF_MPI
-        if (memberin) then
-            call Agrif_Parentbounds(type_interp,nbdim,indmin,indmax,        &
-                                    s_Parent_temp,s_Child_temp,             &
-                                    s_Child,ds_Child,                       &
-                                    s_Parent,ds_Parent,                     &
-                                    pttruetab,cetruetab,                    &
-                                    pttab_Child,pttab_Parent,               &
-                                    child%root_var % posvar, coords)
-        endif
-
-        local_proc = Agrif_Procrank
-        call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
-        call Agrif_ChildGrid_to_ParentGrid()
-!
-        call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
-                               indminglob,indmaxglob, local_proc, coords,   &
-                               indminglob2,indmaxglob2,member)
-!
-        if (member) then
-            call Agrif_GlobalToLocalBounds(parentarray,                     &
-                                           lowerbound,  upperbound,         &
-                                           indminglob2, indmaxglob2, coords,&
-                                           nbdim, local_proc, member)
-        endif
-
-        call Agrif_ParentGrid_to_ChildGrid()
-#else
-        parentarray(:,1,1) = indminglob
-        parentarray(:,2,1) = indmaxglob
-        parentarray(:,1,2) = indminglob
-        parentarray(:,2,2) = indmaxglob
-        indmin = indminglob
-        indmax = indmaxglob
-        member = .TRUE.
-#endif
-
-    else
-
-#if defined AGRIF_MPI
-        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
-        s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
-#else
-        parentarray(:,1,1) = indminglob
-        parentarray(:,2,1) = indmaxglob
-        parentarray(:,1,2) = indminglob
-        parentarray(:,2,2) = indmaxglob
-        indmin = indminglob
-        indmax = indmaxglob
-        member = .TRUE.
-        s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent
-        s_Child_temp  = s_Child + (pttab - pttab_Child) * ds_Child
-#endif
-    endif
-!
-    if (member) then
-        if (.not.associated(tempP)) allocate(tempP)
-!
-        call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim)
-        call Agrif_var_set_array_tozero(tempP,nbdim)
-
-        call Agrif_ChildGrid_to_ParentGrid()
-!
-        select case (nbdim)
-        case(1)
-            call procname(tempP%array1,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir)
-        case(2)
-            call procname(tempP%array2,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir)
-        case(3)
-            call procname(tempP%array3,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),    &
-                      parentarray(3,1,2),parentarray(3,2,2),.TRUE.,nb,ndir)
-        case(4)
-            call procname(tempP%array4,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),    &
-                      parentarray(3,1,2),parentarray(3,2,2),    &
-                      parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir)
-        case(5)
-            call procname(tempP%array5,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),    &
-                      parentarray(3,1,2),parentarray(3,2,2),    &
-                      parentarray(4,1,2),parentarray(4,2,2),    &
-                      parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir)
-        case(6)
-            call procname(tempP%array6,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),    &
-                      parentarray(3,1,2),parentarray(3,2,2),    &
-                      parentarray(4,1,2),parentarray(4,2,2),    &
-                      parentarray(5,1,2),parentarray(5,2,2),    &
-                      parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir)
-        end select
-!
-        call Agrif_ParentGrid_to_ChildGrid()
-!
-    endif
-
-#if defined AGRIF_MPI
-    if (.not.find_list_interp) then
-!
-        tab3(:,1) = indminglob2(:)
-        tab3(:,2) = indmaxglob2(:)
-        tab3(:,3) = indmin(:)
-        tab3(:,4) = indmax(:)
-!
-        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
-
-        if (.not.associated(tempPextend))   allocate(tempPextend)
-
-        do k=0,Agrif_Nbprocs-1
-            do j=1,4
-                do i=1,nbdim
-                    tab4t(i,k,j) = tab4(i,j,k)
-                enddo
-            enddo
-        enddo
-
-        memberin1(1) = memberin
-        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
-
-        call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),         &
-                                     tab4t(:,:,3),tab4t(:,:,4),         &
-                                     nbdim,memberinall, coords,         &
-                                     sendtoproc1,recvfromproc1,         &
-                                     tab4t(:,:,5),tab4t(:,:,6),         &
-                                     tab4t(:,:,7),tab4t(:,:,8) )
-    endif
-
-    call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim,         &
-            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),    &
-            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,tempPextend)
-#else
-    tempPextend => tempP
-#endif
-
-    if (.not.find_list_interp) then
-        call Agrif_Addto_list_interp(                           &
-                child%list_interp,pttab,petab,                  &
-                pttab_Child,pttab_Parent,indmin,indmax,         &
-                indminglob,indmaxglob,                          &
-                pttruetab,cetruetab,                            &
-                memberin,nbdim                                  &
-#if defined AGRIF_MPI
-               ,indminglob2,indmaxglob2,                        &
-                parentarray,                                    &
-                member,                                         &
-                tab4t,memberinall,sendtoproc1,recvfromproc1     &
-#endif
-        )
-    endif
-!
-    if (memberin) then
-!
-        if (.not.associated(tempC)) allocate(tempC)
-!
-        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
-!
-!       Special values on the parent grid
-        if (Agrif_UseSpecialValue) then
-!
-            noraftab(1:nbdim) = child % root_var % interptab(1:nbdim) == 'N'
-!
-            if (.not.associated(parentvalues))  allocate(parentvalues)
-!
-            call Agrif_array_allocate(parentvalues,indmin,indmax,nbdim)
-            call Agrif_var_full_copy_array(parentvalues,tempPextend,nbdim)
-!
-            call Agrif_CheckMasknD(tempPextend,parentvalues,    &
-                    indmin(1:nbdim),indmax(1:nbdim),            &
-                    indmin(1:nbdim),indmax(1:nbdim),            &
-                    noraftab(1:nbdim),nbdim)
-!
-            call Agrif_array_deallocate(parentvalues,nbdim)
-!
-        endif
-!
-!       Interpolation of the current grid
-!
-        if ( memberin ) then
-            select case(nbdim)
-            case(1)
-                call Agrif_Interp_1D_recursive( type_interp(1),                         &
-                                                tempPextend%array1,                     &
-                                                tempC%array1,                           &
-                                                indmin(1), indmax(1),                   &
-                                                pttruetab(1),    cetruetab(1),          &
-                                                s_Child_temp(1), s_Parent_temp(1),      &
-                                                ds_Child(1),     ds_Parent(1) )
-            case(2)
-                call Agrif_Interp_2D_recursive( type_interp(1:2),                       &
-                                                tempPextend % array2,                   &
-                                                tempC       % array2,                   &
-                                                indmin(1:2), indmax(1:2),               &
-                                                pttruetab(1:2),    cetruetab(1:2),      &
-                                                s_Child_temp(1:2), s_Parent_temp(1:2),  &
-                                                ds_Child(1:2),    ds_Parent(1:2) )
-            case(3)
-                call Agrif_Interp_3D_recursive( type_interp(1:3),                       &
-                                                tempPextend % array3,                   &
-                                                tempC       % array3,                   &
-                                                indmin(1:3), indmax(1:3),               &
-                                                pttruetab(1:3),    cetruetab(1:3),      &
-                                                s_Child_temp(1:3), s_Parent_temp(1:3),  &
-                                                ds_Child(1:3),    ds_Parent(1:3) )
-            case(4)
-                call Agrif_Interp_4D_recursive( type_interp(1:4),                       &
-                                                tempPextend % array4,                   &
-                                                tempC       % array4,                   &
-                                                indmin(1:4), indmax(1:4),               &
-                                                pttruetab(1:4),    cetruetab(1:4),      &
-                                                s_Child_temp(1:4), s_Parent_temp(1:4),  &
-                                                ds_Child(1:4),    ds_Parent(1:4) )
-            case(5)
-                call Agrif_Interp_5D_recursive( type_interp(1:5),                       &
-                                                tempPextend % array5,                   &
-                                                tempC       % array5,                   &
-                                                indmin(1:5), indmax(1:5),               &
-                                                pttruetab(1:5),    cetruetab(1:5),      &
-                                                s_Child_temp(1:5), s_Parent_temp(1:5),  &
-                                                ds_Child(1:5),    ds_Parent(1:5) )
-            case(6)
-                call Agrif_Interp_6D_recursive( type_interp(1:6),                       &
-                                                tempPextend % array6,                   &
-                                                tempC       % array6,                   &
-                                                indmin(1:6), indmax(1:6),               &
-                                                pttruetab(1:6),    cetruetab(1:6),      &
-                                                s_Child_temp(1:6), s_Parent_temp(1:6),  &
-                                                ds_Child(1:6),    ds_Parent(1:6) )
-            end select
-!
-            call Agrif_get_var_bounds_array(child,lowerbound,upperbound,nbdim)
-
-#if defined AGRIF_MPI
-            call Agrif_GlobalToLocalBounds(childarray, lowerbound, upperbound,  &
-                                            pttruetab, cetruetab, coords,       &
-                                            nbdim, Agrif_Procrank, memberout)
-#else
-            childarray(:,1,1) = pttruetab
-            childarray(:,2,1) = cetruetab
-            childarray(:,1,2) = pttruetab
-            childarray(:,2,2) = cetruetab
-!cccccccccccccc       memberout = .TRUE.
-#endif
-!
-!           Special values on the child grid
-            if (Agrif_UseSpecialValueFineGrid) then
-                call GiveAgrif_SpecialValueToTab_mpi( child, tempC, childarray, Agrif_SpecialValueFineGrid,nbdim )
-            endif
-!
-        endif   ! ( memberin )
-!
-        if (torestore) then
-!
-#if defined AGRIF_MPI
-!
-            SELECT CASE (nbdim)
-            CASE (1)
-                do i = pttruetab(1),cetruetab(1)
-!hildarrayAModifier     if (restore%restore1D(i) == 0)      &
-!hildarrayAModifier         child%array1(childarray(i,1,2)) = tempC%array1(i)
-                enddo
-            CASE (2)
-                do i = pttruetab(1),cetruetab(1)
-                do j = pttruetab(2),cetruetab(2)
-!hildarrayAModifier     if (restore%restore2D(i,j) == 0)    &
-!hildarrayAModifier         child%array2(childarray(i,1,2), &
-!hildarrayAModifier                          childarray(j,2,2)) = tempC%array2(i,j)
-                enddo
-                enddo
-            CASE (3)
-                do i = pttruetab(1),cetruetab(1)
-                do j = pttruetab(2),cetruetab(2)
-                do k = pttruetab(3),cetruetab(3)
-!hildarrayAModifier     if (restore%restore3D(i,j,k) == 0)  &
-!hildarrayAModifier         child%array3(childarray(i,1,2), &
-!hildarrayAModifier                          childarray(j,2,2), &
-!hildarrayAModifier                          childarray(k,3,2)) = tempC%array3(i,j,k)
-                enddo
-                enddo
-                enddo
-            CASE (4)
-                do i = pttruetab(1),cetruetab(1)
-                do j = pttruetab(2),cetruetab(2)
-                do k = pttruetab(3),cetruetab(3)
-                do l = pttruetab(4),cetruetab(4)
-!hildarrayAModifier     if (restore%restore4D(i,j,k,l) == 0)    &
-!hildarrayAModifier         child%array4(childarray(i,1,2),     &
-!hildarrayAModifier                          childarray(j,2,2),     &
-!hildarrayAModifier                          childarray(k,3,2),     &
-!hildarrayAModifier                          childarray(l,4,2)) = tempC%array4(i,j,k,l)
-                enddo
-                enddo
-                enddo
-                enddo
-            CASE (5)
-                do i = pttruetab(1),cetruetab(1)
-                do j = pttruetab(2),cetruetab(2)
-                do k = pttruetab(3),cetruetab(3)
-                do l = pttruetab(4),cetruetab(4)
-                do m = pttruetab(5),cetruetab(5)
-!hildarrayAModifier     if (restore%restore5D(i,j,k,l,m) == 0)  &
-!hildarrayAModifier         child%array5(childarray(i,1,2),     &
-!hildarrayAModifier                          childarray(j,2,2),     &
-!hildarrayAModifier                          childarray(k,3,2),     &
-!hildarrayAModifier                          childarray(l,4,2),     &
-!hildarrayAModifier                          childarray(m,5,2)) = tempC%array5(i,j,k,l,m)
-                enddo
-                enddo
-                enddo
-                enddo
-                enddo
-            CASE (6)
-                do i = pttruetab(1),cetruetab(1)
-                do j = pttruetab(2),cetruetab(2)
-                do k = pttruetab(3),cetruetab(3)
-                do l = pttruetab(4),cetruetab(4)
-                do m = pttruetab(5),cetruetab(5)
-                do n = pttruetab(6),cetruetab(6)
-!hildarrayAModifier     if (restore%restore6D(i,j,k,l,m,n) == 0)    &
-!hildarrayAModifier         child%array6(childarray(i,1,2),         &
-!hildarrayAModifier                          childarray(j,2,2),         &
-!hildarrayAModifier                          childarray(k,3,2),         &
-!hildarrayAModifier                          childarray(l,4,2),         &
-!hildarrayAModifier                          childarray(m,5,2),         &
-!hildarrayAModifier                          childarray(n,6,2)) = tempC%array6(i,j,k,l,m,n)
-                enddo
-                enddo
-                enddo
-                enddo
-                enddo
-                enddo
-            END SELECT
-!
-#else
-            select case (nbdim)
-            case (1)
-                do i = pttruetab(1),cetruetab(1)
-                    if (restore%restore1D(i) == 0)          &
-                        parray1(i) = tempC % array1(i)
-                enddo
-            case (2)
-                do j = pttruetab(2),cetruetab(2)
-                do i = pttruetab(1),cetruetab(1)
-                    if (restore%restore2D(i,j) == 0)        &
-                        parray2(i,j) = tempC % array2(i,j)
-                enddo
-                enddo
-            case (3)
-                do k = pttruetab(3),cetruetab(3)
-                do j = pttruetab(2),cetruetab(2)
-                do i = pttruetab(1),cetruetab(1)
-                    if (restore%restore3D(i,j,k) == 0)      &
-                        parray3(i,j,k) = tempC % array3(i,j,k)
-                enddo
-                enddo
-                enddo
-            case (4)
-                do l = pttruetab(4),cetruetab(4)
-                do k = pttruetab(3),cetruetab(3)
-                do j = pttruetab(2),cetruetab(2)
-                do i = pttruetab(1),cetruetab(1)
-                    if (restore%restore4D(i,j,k,l) == 0)    &
-                        parray4(i,j,k,l) = tempC % array4(i,j,k,l)
-                enddo
-                enddo
-                enddo
-                enddo
-            case (5)
-                do m = pttruetab(5),cetruetab(5)
-                do l = pttruetab(4),cetruetab(4)
-                do k = pttruetab(3),cetruetab(3)
-                do j = pttruetab(2),cetruetab(2)
-                do i = pttruetab(1),cetruetab(1)
-                    if (restore%restore5D(i,j,k,l,m) == 0)  &
-                        parray5(i,j,k,l,m) = tempC % array5(i,j,k,l,m)
-                enddo
-                enddo
-                enddo
-                enddo
-                enddo
-            case (6)
-                do n = pttruetab(6),cetruetab(6)
-                do m = pttruetab(5),cetruetab(5)
-                do l = pttruetab(4),cetruetab(4)
-                do k = pttruetab(3),cetruetab(3)
-                do j = pttruetab(2),cetruetab(2)
-                do i = pttruetab(1),cetruetab(1)
-                    if (restore%restore6D(i,j,k,l,m,n) == 0)    &
-                        parray6(i,j,k,l,m,n) = tempC % array6(i,j,k,l,m,n)
-                enddo
-                enddo
-                enddo
-                enddo
-                enddo
-                enddo
-            end select
-!
-#endif
-!
-        else    ! .not.to_restore
-!
-            if (memberin) then
-    !
-                if ( .not.in_bc ) then
-                    select case(nbdim)
-                    case(1)
-                        call procname(tempC % array1(            &
-                                childarray(1,1,1):childarray(1,2,1)), &
-                                childarray(1,1,2),childarray(1,2,2),.FALSE.,nb,ndir)
-                    case(2)
-                        call procname(                                &
-                                tempC % array2(            &
-                                childarray(1,1,1):childarray(1,2,1),  &
-                                childarray(2,1,1):childarray(2,2,1)), &
-                                childarray(1,1,2),childarray(1,2,2),  &
-                                childarray(2,1,2),childarray(2,2,2),.FALSE.,nb,ndir)
-                    case(3)
-                        call procname(                                &
-                                tempC % array3(            &
-                                childarray(1,1,1):childarray(1,2,1),  &
-                                childarray(2,1,1):childarray(2,2,1),  &
-                                childarray(3,1,1):childarray(3,2,1)), &
-                                childarray(1,1,2),childarray(1,2,2),  &
-                                childarray(2,1,2),childarray(2,2,2),  &
-                                childarray(3,1,2),childarray(3,2,2),.FALSE.,nb,ndir)
-                    case(4)
-                        call procname(                                &
-                                tempC % array4(            &
-                                childarray(1,1,1):childarray(1,2,1),  &
-                                childarray(2,1,1):childarray(2,2,1),  &
-                                childarray(3,1,1):childarray(3,2,1),  &
-                                childarray(4,1,1):childarray(4,2,1)), &
-                                childarray(1,1,2),childarray(1,2,2),  &
-                                childarray(2,1,2),childarray(2,2,2),  &
-                                childarray(3,1,2),childarray(3,2,2),  &
-                                childarray(4,1,2),childarray(4,2,2),.FALSE.,nb,ndir)
-                    case(5)
-                        call procname(                                &
-                                tempC % array5(            &
-                                childarray(1,1,1):childarray(1,2,1),  &
-                                childarray(2,1,1):childarray(2,2,1),  &
-                                childarray(3,1,1):childarray(3,2,1),  &
-                                childarray(4,1,1):childarray(4,2,1),  &
-                                childarray(5,1,1):childarray(5,2,1)), &
-                                childarray(1,1,2),childarray(1,2,2),  &
-                                childarray(2,1,2),childarray(2,2,2),  &
-                                childarray(3,1,2),childarray(3,2,2),  &
-                                childarray(4,1,2),childarray(4,2,2),  &
-                                childarray(5,1,2),childarray(5,2,2),.FALSE.,nb,ndir)
-                    case(6)
-                        call procname(                                &
-                                tempC % array6(            &
-                                childarray(1,1,1):childarray(1,2,1),  &
-                                childarray(2,1,1):childarray(2,2,1),  &
-                                childarray(3,1,1):childarray(3,2,1),  &
-                                childarray(4,1,1):childarray(4,2,1),  &
-                                childarray(5,1,1):childarray(5,2,1),  &
-                                childarray(6,1,1):childarray(6,2,1)), &
-                                childarray(1,1,2),childarray(1,2,2),  &
-                                childarray(2,1,2),childarray(2,2,2),  &
-                                childarray(3,1,2),childarray(3,2,2),  &
-                                childarray(4,1,2),childarray(4,2,2),  &
-                                childarray(5,1,2),childarray(5,2,2),  &
-                                childarray(6,1,2),childarray(6,2,2),.FALSE.,nb,ndir)
-                    end select
-                else    ! we are in_bc
-                    select case (nbdim)
-                    case (1)
-                        parray1(childarray(1,1,2):childarray(1,2,2)) =    &
-                         tempC%array1(childarray(1,1,1):childarray(1,2,1))
-                    case (2)
-                        parray2(childarray(1,1,2):childarray(1,2,2),      &
-                                      childarray(2,1,2):childarray(2,2,2)) =    &
-                         tempC%array2(childarray(1,1,1):childarray(1,2,1),      &
-                                      childarray(2,1,1):childarray(2,2,1))
-                    case (3)
-                        parray3(childarray(1,1,2):childarray(1,2,2),      &
-                                      childarray(2,1,2):childarray(2,2,2),      &
-                                      childarray(3,1,2):childarray(3,2,2)) =    &
-                         tempC%array3(childarray(1,1,1):childarray(1,2,1),      &
-                                      childarray(2,1,1):childarray(2,2,1),      &
-                                      childarray(3,1,1):childarray(3,2,1))
-                    case (4)
-                        parray4(childarray(1,1,2):childarray(1,2,2),      &
-                                      childarray(2,1,2):childarray(2,2,2),      &
-                                      childarray(3,1,2):childarray(3,2,2),      &
-                                      childarray(4,1,2):childarray(4,2,2)) =    &
-                         tempC%array4(childarray(1,1,1):childarray(1,2,1),      &
-                                      childarray(2,1,1):childarray(2,2,1),      &
-                                      childarray(3,1,1):childarray(3,2,1),      &
-                                      childarray(4,1,1):childarray(4,2,1))
-                    case (5)
-                        parray5(childarray(1,1,2):childarray(1,2,2),      &
-                                      childarray(2,1,2):childarray(2,2,2),      &
-                                      childarray(3,1,2):childarray(3,2,2),      &
-                                      childarray(4,1,2):childarray(4,2,2),      &
-                                      childarray(5,1,2):childarray(5,2,2)) =    &
-                         tempC%array5(childarray(1,1,1):childarray(1,2,1),      &
-                                      childarray(2,1,1):childarray(2,2,1),      &
-                                      childarray(3,1,1):childarray(3,2,1),      &
-                                      childarray(4,1,1):childarray(4,2,1),      &
-                                      childarray(5,1,1):childarray(5,2,1))
-                    case (6)
-                        parray6(childarray(1,1,2):childarray(1,2,2),      &
-                                      childarray(2,1,2):childarray(2,2,2),      &
-                                      childarray(3,1,2):childarray(3,2,2),      &
-                                      childarray(4,1,2):childarray(4,2,2),      &
-                                      childarray(5,1,2):childarray(5,2,2),      &
-                                      childarray(6,1,2):childarray(6,2,2)) =    &
-                         tempC%array6(childarray(1,1,1):childarray(1,2,1),      &
-                                      childarray(2,1,1):childarray(2,2,1),      &
-                                      childarray(3,1,1):childarray(3,2,1),      &
-                                      childarray(4,1,1):childarray(4,2,1),      &
-                                      childarray(5,1,1):childarray(5,2,1),      &
-                                      childarray(6,1,1):childarray(6,2,1))
-                    end select
-                endif  ! < (.not.in_bc)
-            endif  ! < memberin
-!
-        endif
-
-        call Agrif_array_deallocate(tempPextend,nbdim)
-        call Agrif_array_deallocate(tempC,nbdim)
-
-    endif
-!
-!   Deallocations
-#if defined AGRIF_MPI
-    if (member) then
-        call Agrif_array_deallocate(tempP,nbdim)
-    endif
-#endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpnD
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Parentbounds
-!
-!> Calculates the bounds of the parent grid for the interpolation of the child grid
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Parentbounds ( type_interp, nbdim, indmin, indmax, &
-                                s_Parent_temp, s_Child_temp,        &
-                                s_Child, ds_Child,                  &
-                                s_Parent,ds_Parent,                 &
-                                pttruetab, cetruetab,               &
-                                pttab_Child, pttab_Parent, posvar, coords )
-!---------------------------------------------------------------------------------------------------
-    INTEGER, DIMENSION(6),     intent(in)  :: type_interp
-    INTEGER,                   intent(in)  :: nbdim
-    INTEGER, DIMENSION(nbdim), intent(out) :: indmin, indmax
-    REAL,    DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp
-    REAL,    DIMENSION(nbdim), intent(in)  :: s_Child, ds_child
-    REAL,    DIMENSION(nbdim), intent(in)  :: s_Parent,ds_Parent
-    INTEGER, DIMENSION(nbdim), intent(in)  :: pttruetab, cetruetab
-    INTEGER, DIMENSION(nbdim), intent(in)  :: pttab_Child, pttab_Parent
-    INTEGER, DIMENSION(nbdim), intent(in)  :: posvar
-    INTEGER, DIMENSION(nbdim), intent(in)  :: coords
-!
-    INTEGER :: i
-    REAL,DIMENSION(nbdim) :: dim_newmin, dim_newmax
-!
-    dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
-    dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
-!
-    do i = 1,nbdim
-!
-        indmin(i) = pttab_Parent(i) + agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
-        indmax(i) = pttab_Parent(i) + agrif_ceiling((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
-!
-!       Necessary for the Quadratic interpolation
-!
-        if ( (pttruetab(i) == cetruetab(i)) .and. (posvar(i) == 1) ) then
-        elseif ( coords(i) == 0 ) then  ! (interptab == 'N')
-        elseif ( (type_interp(i) == Agrif_ppm)     .or.     &
-                 (type_interp(i) == Agrif_eno)     .or.     &
-                 (type_interp(i) == Agrif_ppm_lim) .or.     &
-                 (type_interp(i) == Agrif_weno) ) then
-            indmin(i) = indmin(i) - 2
-            indmax(i) = indmax(i) + 2
-        elseif ( (type_interp(i) /= Agrif_constant) .and.   &
-                 (type_interp(i) /= Agrif_linear) ) then
-            indmin(i) = indmin(i) - 1
-            indmax(i) = indmax(i) + 1
-        endif
-!
-    enddo
-!
-    s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
-    s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Parentbounds
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Interp_1D_Recursive
-!
-!> Subroutine for the interpolation of a 1D grid variable.
-!> It calls Agrif_InterpBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Interp_1D_recursive ( type_interp, tabin, tabout,  &
-                                       indmin, indmax,              &
-                                       pttab_child, petab_child,    &
-                                       s_child,  s_parent,          &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer,            intent(in)  :: type_interp
-    integer,            intent(in)  :: indmin, indmax
-    integer,            intent(in)  :: pttab_child, petab_child
-    real,               intent(in)  :: s_child, s_parent
-    real,               intent(in)  :: ds_child, ds_parent
-    real, dimension(            &
-        indmin:indmax           &
-    ),                  intent(in)  :: tabin
-    real, dimension(            &
-        pttab_child:petab_child &
-    ),                  intent(out) :: tabout
-!---------------------------------------------------------------------------------------------------
-    call Agrif_InterpBase(type_interp,                      &
-                          tabin(indmin:indmax),             &
-                          tabout(pttab_child:petab_child),  &
-                          indmin, indmax,                   &
-                          pttab_child, petab_child,         &
-                          s_parent,    s_child,             &
-                         ds_parent,   ds_child)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Interp_1D_recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Interp_2D_Recursive
-!
-!> Subroutine for the interpolation of a 2D grid variable.
-!> It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Interp_2D_recursive ( type_interp, tabin, tabout,  &
-                                       indmin, indmax,              &
-                                       pttab_child, petab_child,    &
-                                       s_child,  s_parent,          &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(2),              intent(in)  :: type_interp
-    integer, dimension(2),              intent(in)  :: indmin, indmax
-    integer, dimension(2),              intent(in)  :: pttab_child, petab_child
-    real,    dimension(2),              intent(in)  :: s_child, s_parent
-    real,    dimension(2),              intent(in)  :: ds_child, ds_parent
-    real,    dimension(                 &
-        indmin(1):indmax(1),            &
-        indmin(2):indmax(2)),           intent(in)  :: tabin
-    real,    dimension(                 &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2)), intent(out) :: tabout
-!---------------------------------------------------------------------------------------------------
-    real, dimension(                    &
-        pttab_child(1):petab_child(1),  &
-        indmin(2):indmax(2))            :: tabtemp
-    real, dimension(                    &
-        pttab_child(2):petab_child(2),  &
-        pttab_child(1):petab_child(1))  :: tabout_trsp
-    real, dimension(                    &
-        indmin(2):indmax(2),            &
-        pttab_child(1):petab_child(1))  :: tabtemp_trsp
-    integer                             :: i, j, coeffraf
-!---------------------------------------------------------------------------------------------------
-!
-    coeffraf = nint ( ds_parent(1) / ds_child(1) )
-!
-    if ((type_interp(1) == Agrif_Linear) .and. (coeffraf /= 1)) then
-!---CDIR NEXPAND
-        if(.NOT. precomputedone(1))     &
-            call Linear1dPrecompute2d(                  &
-                    indmax(2)-indmin(2)+1,              &
-                    indmax(1)-indmin(1)+1,              &
-                    petab_child(1)-pttab_child(1)+1,    &
-                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-        call Linear1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
-!
-    elseif ((type_interp(1) == Agrif_PPM) .and. (coeffraf /= 1)) then
-!---CDIR NEXPAND
-        if(.NOT. precomputedone(1))     &
-            call PPM1dPrecompute2d(                     &
-                    indmax(2)-indmin(2)+1,              &
-                    indmax(1)-indmin(1)+1,              &
-                    petab_child(1)-pttab_child(1)+1,        &
-                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-        call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
-    else
-        do j = indmin(2),indmax(2)
-!
-!---CDIR NEXPAND
-            call Agrif_Interp_1D_recursive(type_interp(1),                  &
-                    tabin(indmin(1):indmax(1),j),               &
-                    tabtemp(pttab_child(1):petab_child(1),j),   &
-                    indmin(1),indmax(1),                    &
-                    pttab_child(1),petab_child(1),          &
-                    s_child(1), s_parent(1),                &
-                    ds_child(1),ds_parent(1))
-!
-        enddo
-    endif
-
-    coeffraf = nint(ds_parent(2)/ds_child(2))
-    tabtemp_trsp = TRANSPOSE(tabtemp)
-
-    if ((type_interp(2) == Agrif_Linear) .and. (coeffraf /= 1)) then
-!---CDIR NEXPAND
-        if(.NOT. precomputedone(2))     &
-            call Linear1dPrecompute2d(                  &
-                    petab_child(1)-pttab_child(1)+1,    &
-                    indmax(2)-indmin(2)+1,              &
-                    petab_child(2)-pttab_child(2)+1,    &
-                    s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-        call Linear1dAfterCompute(tabtemp_trsp,tabout_trsp, &
-                size(tabtemp_trsp),size(tabout_trsp),2)
-
-    elseif ((type_interp(2) == Agrif_PPM) .and. (coeffraf /= 1)) then
-!---CDIR NEXPAND
-        if(.NOT. precomputedone(2))     &
-            call PPM1dPrecompute2d(                     &
-                    petab_child(1)-pttab_child(1)+1,    &
-                    indmax(2)-indmin(2)+1,              &
-                    petab_child(2)-pttab_child(2)+1,    &
-                    s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-        call PPM1dAfterCompute(tabtemp_trsp, tabout_trsp,    &
-                               size(tabtemp_trsp), size(tabout_trsp), 2)
-    else
-        do i = pttab_child(1), petab_child(1)
-!
-!---CDIR NEXPAND
-            call Agrif_InterpBase(type_interp(2),                                   &
-                                  tabtemp_trsp(indmin(2):indmax(2), i),             &
-                                  tabout_trsp(pttab_child(2):petab_child(2), i),    &
-                                  indmin(2), indmax(2),                             &
-                                  pttab_child(2), petab_child(2),                   &
-                                  s_parent(2),    s_child(2),                       &
-                                 ds_parent(2),   ds_child(2) )
-        enddo
-    endif
-!
-    tabout = TRANSPOSE(tabout_trsp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Interp_2D_recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Interp_3D_Recursive
-!
-!> Subroutine for the interpolation of a 3D grid variable.
-!> It calls #Agrif_Interp_2D_recursive and #Agrif_InterpBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Interp_3D_recursive ( type_interp, tabin, tabout,  &
-                                       indmin, indmax,              &
-                                       pttab_child, petab_child,    &
-                                       s_child,  s_parent,          &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(3),              intent(in)  :: type_interp
-    integer, dimension(3),              intent(in)  :: indmin, indmax
-    integer, dimension(3),              intent(in)  :: pttab_child, petab_child
-    real,    dimension(3),              intent(in)  :: s_child, s_parent
-    real,    dimension(3),              intent(in)  :: ds_child, ds_parent
-    real,    dimension(                 &
-        indmin(1):indmax(1),            &
-        indmin(2):indmax(2),            &
-        indmin(3):indmax(3)),           intent(in)  :: tabin
-    real,    dimension(                 &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2),  &
-        pttab_child(3):petab_child(3)), intent(out) :: tabout
-!---------------------------------------------------------------------------------------------------
-    real, dimension(                    &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2),  &
-        indmin(3):indmax(3))            :: tabtemp
-    integer                             :: i, j, k, coeffraf
-    integer                             :: locind_child_left, kdeb
-!
-    coeffraf = nint ( ds_parent(1) / ds_child(1) )
-    if ( (type_interp(1) == Agrif_Linear) .and. (coeffraf/=1) ) then
-        call Linear1dPrecompute2d(indmax(2)-indmin(2)+1,            &
-                                  indmax(1)-indmin(1)+1,            &
-                                  petab_child(1)-pttab_child(1)+1,  &
-                                  s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-        precomputedone(1) = .TRUE.
-    elseif ( (type_interp(1) == Agrif_PPM) .and. (coeffraf/=1) ) then
-        call PPM1dPrecompute2d(indmax(2)-indmin(2)+1,           &
-                               indmax(1)-indmin(1)+1,           &
-                               petab_child(1)-pttab_child(1)+1, &
-                               s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-        precomputedone(1) = .TRUE.
-    endif
-
-    coeffraf = nint ( ds_parent(2) / ds_child(2) )
-    if ( (type_interp(2) == Agrif_Linear) .and. (coeffraf/=1) ) then
-        call Linear1dPrecompute2d(petab_child(1)-pttab_child(1)+1,  &
-                                  indmax(2)-indmin(2)+1,            &
-                                  petab_child(2)-pttab_child(2)+1,  &
-                                  s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-        precomputedone(2) = .TRUE.
-    elseif ( (type_interp(2) == Agrif_PPM) .and. (coeffraf/=1) ) then
-        call PPM1dPrecompute2d(petab_child(1)-pttab_child(1)+1, &
-                               indmax(2)-indmin(2)+1,           &
-                               petab_child(2)-pttab_child(2)+1, &
-                               s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-        precomputedone(2) = .TRUE.
-    endif
-!
-    do k = indmin(3), indmax(3)
-        call Agrif_Interp_2D_recursive(type_interp(1:2),                            &
-                                       tabin(indmin(1):indmax(1),                   &
-                                             indmin(2):indmax(2), k),               &
-                                       tabtemp(pttab_child(1):petab_child(1),       &
-                                               pttab_child(2):petab_child(2), k),   &
-                                       indmin(1:2), indmax(1:2),                    &
-                                       pttab_child(1:2), petab_child(1:2),          &
-                                       s_child(1:2),     s_parent(1:2),             &
-                                       ds_child(1:2),   ds_parent(1:2) )
-    enddo
-!
-    precomputedone(1) = .FALSE.
-    precomputedone(2) = .FALSE.
-    coeffraf = nint(ds_parent(3)/ds_child(3))
-!
-    if ( coeffraf == 1 ) then
-        locind_child_left = 1 + agrif_int((s_child(3)-s_parent(3))/ds_parent(3))
-        kdeb = indmin(3)+locind_child_left-2
-        do k = pttab_child(3),petab_child(3)
-            kdeb = kdeb + 1
-            do j = pttab_child(2), petab_child(2)
-            do i = pttab_child(1), petab_child(1)
-                tabout(i,j,k) = tabtemp(i,j,kdeb)
-            enddo
-            enddo
-        enddo
-    else
-        do j = pttab_child(2), petab_child(2)
-        do i = pttab_child(1), petab_child(1)
-            call Agrif_InterpBase(type_interp(3),                                   &
-                                  tabtemp(i,j,indmin(3):indmax(3)),                 &
-                                  tabout(i,j,pttab_child(3):petab_child(3)),        &
-                                  indmin(3), indmax(3),                             &
-                                  pttab_child(3), petab_child(3),                   &
-                                  s_parent(3),    s_child(3),                       &
-                                 ds_parent(3),   ds_child(3) )
-        enddo
-        enddo
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Interp_3D_recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Interp_4D_Recursive
-!
-!> Subroutine for the interpolation of a 4D grid variable.
-!> It calls #Agrif_Interp_3D_recursive and #Agrif_InterpBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Interp_4D_recursive ( type_interp, tabin, tabout,  &
-                                       indmin, indmax,              &
-                                       pttab_child, petab_child,    &
-                                       s_child,  s_parent,          &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(4),              intent(in)  :: type_interp
-    integer, dimension(4),              intent(in)  :: indmin, indmax
-    integer, dimension(4),              intent(in)  :: pttab_child, petab_child
-    real,    dimension(4),              intent(in)  :: s_child, s_parent
-    real,    dimension(4),              intent(in)  :: ds_child, ds_parent
-    real,    dimension(                 &
-        indmin(1):indmax(1),            &
-        indmin(2):indmax(2),            &
-        indmin(3):indmax(3),            &
-        indmin(4):indmax(4)),           intent(in)  :: tabin
-    real,    dimension(                 &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2),  &
-        pttab_child(3):petab_child(3),  &
-        pttab_child(4):petab_child(4)), intent(out) :: tabout
-!---------------------------------------------------------------------------------------------------
-    real, dimension(                    &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2),  &
-        pttab_child(3):petab_child(3),  &
-        indmin(4):indmax(4))            :: tabtemp
-    integer                             :: i, j, k, l
-!
-    do l = indmin(4), indmax(4)
-        call Agrif_Interp_3D_recursive(type_interp(1:3),                            &
-                                       tabin(indmin(1):indmax(1),                   &
-                                             indmin(2):indmax(2),                   &
-                                             indmin(3):indmax(3), l),               &
-                                       tabtemp(pttab_child(1):petab_child(1),       &
-                                               pttab_child(2):petab_child(2),       &
-                                               pttab_child(3):petab_child(3), l),   &
-                                       indmin(1:3), indmax(1:3),                    &
-                                       pttab_child(1:3), petab_child(1:3),          &
-                                       s_child(1:3),    s_parent(1:3),              &
-                                       ds_child(1:3),  ds_parent(1:3) )
-    enddo
-!
-    do k = pttab_child(3), petab_child(3)
-    do j = pttab_child(2), petab_child(2)
-    do i = pttab_child(1), petab_child(1)
-        call Agrif_InterpBase(type_interp(4),                                       &
-                              tabtemp(i,j,k,indmin(4):indmax(4)),                   &
-                              tabout(i,j,k,pttab_child(4):petab_child(4)),          &
-                              indmin(4), indmax(4),                                 &
-                              pttab_child(4), petab_child(4),                       &
-                              s_parent(4),    s_child(4),                           &
-                             ds_parent(4),   ds_child(4) )
-    enddo
-    enddo
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Interp_4D_recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Interp_5D_Recursive
-!
-!> Subroutine for the interpolation of a 5D grid variable.
-!> It calls #Agrif_Interp_4D_recursive and #Agrif_InterpBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Interp_5D_recursive ( type_interp, tabin, tabout,  &
-                                       indmin, indmax,              &
-                                       pttab_child, petab_child,    &
-                                       s_child,  s_parent,          &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(5),              intent(in)  :: type_interp
-    integer, dimension(5),              intent(in)  :: indmin, indmax
-    integer, dimension(5),              intent(in)  :: pttab_child, petab_child
-    real,    dimension(5),              intent(in)  :: s_child, s_parent
-    real,    dimension(5),              intent(in)  :: ds_child, ds_parent
-    real,    dimension(                 &
-        indmin(1):indmax(1),            &
-        indmin(2):indmax(2),            &
-        indmin(3):indmax(3),            &
-        indmin(4):indmax(4),            &
-        indmin(5):indmax(5)),           intent(in)  :: tabin
-    real,    dimension(                 &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2),  &
-        pttab_child(3):petab_child(3),  &
-        pttab_child(4):petab_child(4),  &
-        pttab_child(5):petab_child(5)), intent(out) :: tabout
-!---------------------------------------------------------------------------------------------------
-    real, dimension(                    &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2),  &
-        pttab_child(3):petab_child(3),  &
-        pttab_child(4):petab_child(4),  &
-        indmin(5):indmax(5))            :: tabtemp
-    integer                             :: i, j, k, l, m
-!
-    do m = indmin(5), indmax(5)
-        call Agrif_Interp_4D_recursive(type_interp(1:4),                            &
-                                       tabin(indmin(1):indmax(1),                   &
-                                             indmin(2):indmax(2),                   &
-                                             indmin(3):indmax(3),                   &
-                                             indmin(4):indmax(4),m),                &
-                                       tabtemp(pttab_child(1):petab_child(1),       &
-                                               pttab_child(2):petab_child(2),       &
-                                               pttab_child(3):petab_child(3),       &
-                                               pttab_child(4):petab_child(4), m),   &
-                                       indmin(1:4),indmax(1:4),                     &
-                                       pttab_child(1:4), petab_child(1:4),          &
-                                       s_child(1:4),     s_parent(1:4),             &
-                                       ds_child(1:4),   ds_parent(1:4) )
-    enddo
-!
-    do l = pttab_child(4), petab_child(4)
-    do k = pttab_child(3), petab_child(3)
-    do j = pttab_child(2), petab_child(2)
-    do i = pttab_child(1), petab_child(1)
-        call Agrif_InterpBase(type_interp(5),                                       &
-                              tabtemp(i,j,k,l,indmin(5):indmax(5)),                 &
-                              tabout(i,j,k,l,pttab_child(5):petab_child(5)),        &
-                              indmin(5), indmax(5),                                 &
-                              pttab_child(5), petab_child(5),                       &
-                              s_parent(5),   s_child(5),                            &
-                              ds_parent(5), ds_child(5) )
-    enddo
-    enddo
-    enddo
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Interp_5D_recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Interp_6D_Recursive
-!
-!> Subroutine for the interpolation of a 6D grid variable.
-!> It calls #Agrif_Interp_5D_recursive and Agrif_InterpBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Interp_6D_recursive ( type_interp, tabin, tabout,  &
-                                       indmin, indmax,              &
-                                       pttab_child, petab_child,    &
-                                       s_child,  s_parent,          &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(6),                  intent(in)  :: type_interp
-    integer, dimension(6),                  intent(in)  :: indmin, indmax
-    integer, dimension(6),                  intent(in)  :: pttab_child, petab_child
-    real,    dimension(6),                  intent(in)  :: s_child, s_parent
-    real,    dimension(6),                  intent(in)  :: ds_child, ds_parent
-    real,    dimension(                 &
-        indmin(1):indmax(1),            &
-        indmin(2):indmax(2),            &
-        indmin(3):indmax(3),            &
-        indmin(4):indmax(4),            &
-        indmin(5):indmax(5),            &
-        indmin(6):indmax(6)),               intent(in)  :: tabin
-    real,    dimension(                 &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2),  &
-        pttab_child(3):petab_child(3),  &
-        pttab_child(4):petab_child(4),  &
-        pttab_child(5):petab_child(5),  &
-        pttab_child(6):petab_child(6)),     intent(out) :: tabout
-!---------------------------------------------------------------------------------------------------
-    real, dimension(                    &
-        pttab_child(1):petab_child(1),  &
-        pttab_child(2):petab_child(2),  &
-        pttab_child(3):petab_child(3),  &
-        pttab_child(4):petab_child(4),  &
-        pttab_child(5):petab_child(5),  &
-        indmin(6):indmax(6))            :: tabtemp
-    integer                             :: i, j, k, l, m, n
-!
-    do n = indmin(6), indmax(6)
-        call Agrif_Interp_5D_recursive(type_interp(1:5),                            &
-                                       tabin(indmin(1):indmax(1),                   &
-                                             indmin(2):indmax(2),                   &
-                                             indmin(3):indmax(3),                   &
-                                             indmin(4):indmax(4),                   &
-                                             indmin(5):indmax(5), n),               &
-                                        tabtemp(pttab_child(1):petab_child(1),      &
-                                                pttab_child(2):petab_child(2),      &
-                                                pttab_child(3):petab_child(3),      &
-                                                pttab_child(4):petab_child(4),      &
-                                                pttab_child(5):petab_child(5), n),  &
-                                        indmin(1:5),indmax(1:5),                    &
-                                        pttab_child(1:5), petab_child(1:5),         &
-                                        s_child(1:5), s_parent(1:5),                &
-                                        ds_child(1:5),ds_parent(1:5) )
-    enddo
-!
-    do m = pttab_child(5), petab_child(5)
-    do l = pttab_child(4), petab_child(4)
-    do k = pttab_child(3), petab_child(3)
-    do j = pttab_child(2), petab_child(2)
-    do i = pttab_child(1), petab_child(1)
-        call Agrif_InterpBase(type_interp(6),                                       &
-                              tabtemp(i,j,k,l,m,indmin(6):indmax(6)),               &
-                              tabout(i,j,k,l,m,pttab_child(6):petab_child(6)),      &
-                              indmin(6), indmax(6),                                 &
-                              pttab_child(6), petab_child(6),                       &
-                              s_parent(6),   s_child(6),                            &
-                              ds_parent(6), ds_child(6) )
-    enddo
-    enddo
-    enddo
-    enddo
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Interp_6D_recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_InterpBase
-!
-!> Calls the interpolation method chosen by the user (linear, lagrange, spline, etc.).
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_InterpBase ( type_interp, parenttab, childtab, indmin, indmax, &
-                              pttab_child, petab_child,                         &
-                              s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    INTEGER                                                 :: type_interp
-    INTEGER                                                 :: indmin, indmax
-    INTEGER                                                 :: pttab_child, petab_child
-    REAL, DIMENSION(indmin:indmax),           INTENT(IN)    :: parenttab
-    REAL, DIMENSION(pttab_child:petab_child), INTENT(OUT)   :: childtab
-    REAL                                                    :: s_parent, s_child
-    REAL                                                    :: ds_parent,ds_child
-!
-    if ( (indmin == indmax) .and. (pttab_child == petab_child) ) then
-!
-        childtab(pttab_child) = parenttab(indmin)
-!
-    elseif (type_interp == Agrif_LINEAR) then    !       Linear interpolation
-!
-        call Agrif_basicinterp_linear1D(parenttab,childtab,                   &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    elseif ( type_interp == Agrif_PPM ) then     !       PPM interpolation
-
-        call PPM1d(parenttab,childtab,                      &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    elseif ( type_interp == Agrif_PPM_LIM ) then     !       PPM interpolation
-
-        call PPM1d_lim(parenttab,childtab,                      &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    elseif (type_interp == Agrif_LAGRANGE) then  !       Lagrange interpolation
-!
-        call lagrange1D(parenttab,childtab,                 &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    elseif (type_interp == Agrif_ENO) then       !       Eno interpolation
-!
-        call ENO1d(parenttab,childtab,                      &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    elseif (type_interp == Agrif_WENO) then      !       Weno interpolation
-!
-        call WENO1d(parenttab,childtab,                     &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    elseif (type_interp == Agrif_LINEARCONSERV) then !   Linear conservative interpolation
-!
-        call Linear1dConserv(parenttab,childtab,            &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    elseif (type_interp == Agrif_LINEARCONSERVLIM) then !Linear conservative interpolation
-!
-        call Linear1dConservLim(parenttab,childtab,         &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    elseif (type_interp == Agrif_CONSTANT) then
-!
-        call Constant1d(parenttab,childtab,                 &
-                indmax-indmin+1,petab_child-pttab_child+1,  &
-                s_parent,s_child,ds_parent,ds_child)
-!
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_InterpBase
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Find_list_interp
-!---------------------------------------------------------------------------------------------------
-function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,     &
-                                    nbdim, indmin, indmax, indminglob,  indmaxglob,         &
-                                    pttruetab, cetruetab, memberin                          &
-#if defined AGRIF_MPI
-                                   ,indminglob2, indmaxglob2, parentarray,                  &
-                                    member, tab4t, memberinall, sendtoproc1, recvfromproc1  &
-#endif
-    ) result(find_list_interp)
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_List_Interp_Loc),   pointer     :: list_interp
-    integer,                       intent(in)  :: nbdim
-    integer, dimension(nbdim),     intent(in)  :: pttab, petab, pttab_Child, pttab_Parent
-    integer, dimension(nbdim),     intent(out) :: indmin, indmax
-    integer, dimension(nbdim),     intent(out) :: indminglob, indmaxglob
-    integer, dimension(nbdim),     intent(out) :: pttruetab, cetruetab
-    logical,                       intent(out) :: memberin
-#if defined AGRIF_MPI
-    integer, dimension(nbdim),     intent(out) :: indminglob2, indmaxglob2
-    integer, dimension(nbdim,2,2), intent(out) :: parentarray
-    logical,                       intent(out) :: member
-    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t
-    logical, dimension(0:Agrif_Nbprocs-1),         intent(out) :: memberinall
-    logical, dimension(0:Agrif_Nbprocs-1),         intent(out) :: sendtoproc1, recvfromproc1
-#endif
-    logical :: find_list_interp
-!
-    integer :: i
-    type(Agrif_List_Interp_Loc), pointer :: parcours
-    type(Agrif_Interp_Loc),      pointer :: pil
-
-    find_list_interp = .false.
-
-    if ( .not. associated(list_interp) )    return
-
-    parcours => list_interp
-    find_loop : do while ( associated(parcours) )
-
-        pil => parcours % interp_loc
-
-        do i = 1,nbdim
-            if ( (pttab(i) /= pil % pttab(i)) .or. &
-                 (petab(i) /= pil % petab(i)) .or. &
-                 (pttab_child(i)  /= pil % pttab_child(i)) .or. &
-                 (pttab_parent(i) /= pil % pttab_parent(i)) ) then
-                parcours => parcours % suiv
-                cycle find_loop
-            endif
-        enddo
-
-        indmin = pil % indmin(1:nbdim)
-        indmax = pil % indmax(1:nbdim)
-
-        pttruetab = pil % pttruetab(1:nbdim)
-        cetruetab = pil % cetruetab(1:nbdim)
-
-#if !defined AGRIF_MPI
-        indminglob  = pil % indminglob(1:nbdim)
-        indmaxglob  = pil % indmaxglob(1:nbdim)
-#else
-        indminglob  = pil % indminglob2(1:nbdim)
-        indmaxglob  = pil % indmaxglob2(1:nbdim)
-        indminglob2 = pil % indminglob2(1:nbdim)
-        indmaxglob2 = pil % indmaxglob2(1:nbdim)
-        parentarray = pil % parentarray(1:nbdim,:,:)
-        member      = pil % member
-        tab4t         = pil % tab4t(1:nbdim, 0:Agrif_Nbprocs-1, 1:8)
-        memberinall   = pil % memberinall(0:Agrif_Nbprocs-1)
-        sendtoproc1   = pil % sendtoproc1(0:Agrif_Nbprocs-1)
-        recvfromproc1 = pil % recvfromproc1(0:Agrif_Nbprocs-1)
-#endif
-        memberin = pil % memberin
-        find_list_interp = .true.
-        exit find_loop
-    enddo find_loop
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Find_list_interp
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_AddTo_list_interp
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_AddTo_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,  &
-                                     indmin, indmax, indminglob, indmaxglob,                &
-                                     pttruetab, cetruetab,                                  &
-                                     memberin, nbdim                                        &
-#if defined AGRIF_MPI
-                                    ,indminglob2, indmaxglob2,                              &
-                                     parentarray,                                           &
-                                     member,                                                &
-                                     tab4t, memberinall, sendtoproc1, recvfromproc1         &
-#endif
-    )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_List_Interp_Loc), pointer    :: list_interp
-    integer                                 :: nbdim
-    integer, dimension(nbdim)               :: pttab, petab, pttab_Child, pttab_Parent
-    integer, dimension(nbdim)               :: indmin,indmax
-    integer, dimension(nbdim)               :: indminglob, indmaxglob
-    integer, dimension(nbdim)               :: pttruetab, cetruetab
-    logical                                 :: memberin
-#if defined AGRIF_MPI
-    integer, dimension(nbdim,2,2)           :: parentarray
-    logical                                 :: member
-    integer, dimension(nbdim)                       :: indminglob2,indmaxglob2
-    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
-    logical, dimension(0:Agrif_Nbprocs-1)           :: memberinall
-    logical, dimension(0:Agrif_Nbprocs-1)           :: sendtoproc1
-    logical, dimension(0:Agrif_Nbprocs-1)           :: recvfromproc1
-#endif
-!
-    type(Agrif_List_Interp_Loc), pointer    :: parcours
-    type(Agrif_Interp_Loc),      pointer    :: pil
-!
-    allocate(parcours)
-    allocate(parcours % interp_loc)
-
-    pil => parcours % interp_loc
-
-    pil % pttab(1:nbdim) = pttab(1:nbdim)
-    pil % petab(1:nbdim) = petab(1:nbdim)
-    pil % pttab_child(1:nbdim) = pttab_child(1:nbdim)
-    pil % pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
-
-    pil % indmin(1:nbdim) = indmin(1:nbdim)
-    pil % indmax(1:nbdim) = indmax(1:nbdim)
-
-    pil % memberin = memberin
-#if !defined AGRIF_MPI
-    pil % indminglob(1:nbdim) = indminglob(1:nbdim)
-    pil % indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
-#else
-    pil % indminglob2(1:nbdim) = indminglob2(1:nbdim)
-    pil % indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
-    pil % parentarray(1:nbdim,:,:) = parentarray(1:nbdim,:,:)
-    pil % member = member
-    allocate(pil % tab4t(nbdim, 0:Agrif_Nbprocs-1, 8))
-    allocate(pil % memberinall(0:Agrif_Nbprocs-1))
-    allocate(pil % sendtoproc1(0:Agrif_Nbprocs-1))
-    allocate(pil % recvfromproc1(0:Agrif_Nbprocs-1))
-    pil % tab4t         = tab4t
-    pil % memberinall   = memberinall
-    pil % sendtoproc1   = sendtoproc1
-    pil % recvfromproc1 = recvfromproc1
-#endif
-
-    pil % pttruetab(1:nbdim) = pttruetab(1:nbdim)
-    pil % cetruetab(1:nbdim) = cetruetab(1:nbdim)
-
-    parcours % suiv => list_interp
-    list_interp => parcours
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Addto_list_interp
-!===================================================================================================
-!
-end module Agrif_Interpolation
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 10251)
@@ -0,0 +1,1706 @@
+!
+! $Id: modinterpbasic.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Interpbasic
+C
+      Module Agrif_Interpbasic
+C
+CCC   Description:
+CCC   Module containing different procedures of interpolation (linear,lagrange,
+CCC   spline,...) used in the Agrif_Interpolation module.
+C
+C     Modules used:
+      USE Agrif_types
+C
+      IMPLICIT NONE
+C             
+      Real,Dimension(Agrif_MaxRaff) :: tabdiff2, tabdiff3
+      Real,Dimension(5,Agrif_MaxRaff,3) :: tabppm
+      Real,Dimension(:),Allocatable::tabtest4   
+      Integer, Dimension(:,:), Allocatable :: indparent
+      Integer, Dimension(:,:), Allocatable :: 
+     &           indparentppm,indchildppm
+      Integer, Dimension(:), Allocatable :: 
+     &           indparentppm_1d,indchildppm_1d
+      Real, Dimension(:,:),Allocatable :: coeffparent   
+       
+      CONTAINS
+C     Define procedures contained in this module
+C  
+C     **************************************************************************  
+CCC   Subroutine Linear1d  
+C     ************************************************************************** 
+C 
+      Subroutine Linear1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child 
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+      
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1.
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2           
+        endif
+        
+        diff=(globind_parent_right - ypos2)
+        y(i) = (diff*x(locind_parent_left)
+     &        + (1.-diff)*x(locind_parent_left+1))
+C
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+C
+      if (locind_parent_left == np) then
+C
+          y(nc) = x(np)
+C
+        else
+C
+          globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent  
+C      
+          y(nc) = ((globind_parent_left + ds_parent - ypos)
+     &            *x(locind_parent_left)
+     &          + (ypos - globind_parent_left)
+     &            *x(locind_parent_left+1))*invds
+C
+      endif                                          
+C           
+      Return
+C
+C       
+      End Subroutine Linear1d   
+      
+      Subroutine Linear1dprecompute2d(np2, np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to compute 2D coefficient and index for a linear 1D interpolation
+CCC   on a child grid (vector y) from its parent grid (vector x).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: np,nc,np2,dir
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,j,coeffraf,locind_parent_left,inc,inc1,inc2,toto 
+      Integer, Dimension(:,:), Allocatable :: indparent_tmp
+      Real, Dimension(:,:), Allocatable :: coeffparent_tmp
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2, invds3
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      ypos = s_child
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      invds3 = 0.5/real(coeffraf)
+
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+
+      if (.not.allocated(indparent)) then
+      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+      else
+      if (size(indparent,1)<nc*np2) then
+      allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
+      allocate(indparent_tmp(size(indparent,1),size(indparent,2)))
+      coeffparent_tmp=coeffparent 
+      indparent_tmp=indparent 
+      deallocate(indparent,coeffparent)
+      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+      coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2))
+     &  = coeffparent_tmp 
+      indparent(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indparent_tmp
+      deallocate(indparent_tmp,coeffparent_tmp)
+      endif
+      endif
+
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2
+        endif
+
+        diff=(globind_parent_right - ypos2)
+        diff = invds3*nint(2*coeffraf*diff)
+        indparent(i,dir) = locind_parent_left
+
+        coeffparent(i,dir) = diff
+        
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+      if (locind_parent_left == np) then
+      indparent(nc,dir) = locind_parent_left-1
+      coeffparent(nc,dir) = 0.
+        else
+C
+          globind_parent_left = s_parent
+     &                        + (locind_parent_left - 1)*ds_parent
+C      
+       indparent(nc,dir) = locind_parent_left
+       diff = (globind_parent_left + ds_parent - ypos)
+     &       * invds
+        diff = invds3*nint(2*coeffraf*diff)
+         coeffparent(nc,dir) = diff
+      endif                                           
+
+      do i=2, np2
+      inc  =  i*nc
+      inc1 = (i-1)*nc
+      inc2 = (i-2)*nc 
+!CDIR ALTCODE
+      indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
+!CDIR ALTCODE
+      coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
+      enddo      
+
+      Return
+C
+C       
+      End Subroutine Linear1dprecompute2d
+
+
+
+      Subroutine Linear1dprecompute(np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to compute 1D coefficient and index for a linear 1D interpolation
+CCC   on a child grid (vector y) from its parent grid (vector x).
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc 
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2, invds3
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child 
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      invds3 = 0.5/real(coeffraf)      
+      
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+      
+      if (.not.allocated(indparent)) then
+      allocate(indparent(nc,1),coeffparent(nc,1))
+      else
+      if (size(indparent)<nc) then
+      deallocate(indparent,coeffparent)
+      allocate(indparent(nc,1),coeffparent(nc,1))
+      endif
+      endif
+      
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2           
+        endif
+        
+        diff=(globind_parent_right - ypos2)
+        
+        diff = invds3*nint(2*coeffraf*diff)
+                
+        indparent(i,1) = locind_parent_left
+
+        coeffparent(i,1) = diff
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      
+      if (locind_parent_left == np) then
+      indparent(nc,1) = locind_parent_left-1
+      coeffparent(nc,1) = 0.
+        else
+C
+          globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent  
+C      
+       indparent(nc,1) = locind_parent_left
+       
+       diff = (globind_parent_left + ds_parent - ypos)
+     &       * invds
+        diff = invds3*nint(2*coeffraf*diff)
+         coeffparent(nc,1) = diff
+      endif                                          
+C           
+      Return
+C
+C       
+      End Subroutine Linear1dprecompute 
+      
+      Subroutine Linear1daftercompute(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x) using precomputed coefficient and index.  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc,dir      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2
+      REAL :: ypos2,diff
+C
+C
+
+!CDIR ALTCODE
+!CDIR NODEP
+      do i = 1,nc
+C
+       y(i)=coeffparent(i,dir)*x(MAX(indparent(i,dir),1))+
+     &      (1.-coeffparent(i,dir))*x(indparent(i,dir)+1)
+C
+      enddo                                     
+C           
+      Return
+C
+C       
+      End Subroutine Linear1daftercompute            
+       
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Lagrange1d  
+C     **************************************************************************
+C
+      Subroutine Lagrange1d(x,y,np,nc,
+     &                      s_parent,s_child,ds_parent,ds_child)
+C
+CCC   Description:
+CCC   Subroutine to do a lagrange 1D interpolation on a child grid (vector y) 
+CCC   from its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C             
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child 
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left
+      REAL    :: X1,X2,X3 
+      real :: deltax,invdsparent
+      real t1,t2,t3,t4,t5,t6,t7,t8
+C
+C 
+      if (np <= 2) then
+C      
+          Call Linear1D(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child)
+C         
+         Return
+C 
+      endif
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      endif
+      
+      invdsparent=1./ds_parent
+C
+      ypos = s_child      
+C
+      do i = 1,nc
+C
+        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+C
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent 
+     
+C        deltax = invdsparent*(ypos-globind_parent_left)
+        deltax = nint(coeffraf*deltax)/real(coeffraf)
+        
+        ypos = ypos + ds_child
+         if (abs(deltax).LE.0.0001) then
+           y(i)=x(locind_parent_left)
+           
+           cycle
+         endif
+C           
+C
+        t2 = deltax - 2.
+        t3 = deltax - 1.
+        t4 = deltax + 1.
+        
+        t5 = -(1./6.)*deltax*t2*t3
+        t6 = 0.5*t2*t3*t4
+        t7 = -0.5*deltax*t2*t4
+        t8 = (1./6.)*deltax*t3*t4
+        
+        y(i)=t5*x(locind_parent_left-1)+t6*x(locind_parent_left)
+     &  +t7*x(locind_parent_left+1)+t8*x(locind_parent_left+2)
+C
+C
+      enddo
+C
+      return
+C
+C       
+      End Subroutine Lagrange1d 
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Constant1d  
+C     ************************************************************************** 
+C 
+      Subroutine constant1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent
+      REAL    :: ypos
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent:locind_parent+nc-1)
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child      
+C
+      do i = 1,nc
+C
+        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
+C
+        y(i) = x(locind_parent)
+C
+        ypos = ypos + ds_child
+C
+      enddo
+C           
+      Return
+C
+C       
+      End Subroutine constant1d   
+C
+C     **************************************************************************  
+CCC   Subroutine Linear1dconserv
+C     ************************************************************************** 
+C 
+      Subroutine Linear1dconserv(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Real    :: ypos
+      integer :: i1,i2,ii
+      real :: xpmin,xpmax,slope
+      INTEGER :: diffmod
+      REAL :: xdiffmod
+
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      End If
+C              
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1  
+
+      xdiffmod = real(diffmod)/2.
+                         
+      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+C
+      ypos = s_child  
+C      
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+
+      locind_parent_last = 1 +
+     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+     
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
+      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
+      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+      i = i1
+      
+      if (locind_parent_left == 1) then
+        slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
+      else
+         slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo 
+
+        locind_parent_left = locind_parent_left + 1
+                      
+      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf
+        slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+      enddo
+      
+      i = i2
+      
+      if (locind_parent_left == np) then
+        slope=
+     &   (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
+      else
+         slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,nc
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo      
+C
+      y(1:nc)=ytemp(1:nc)                                   
+C           
+      deallocate(ytemp)
+      Return
+C       
+      End Subroutine Linear1dconserv
+      
+C
+C     **************************************************************************  
+CCC   Subroutine Linear1dconservlim
+C     ************************************************************************** 
+C 
+      Subroutine Linear1dconservlim(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Real    :: ypos
+      integer :: i1,i2,ii
+      real :: xpmin,xpmax,slope
+      INTEGER :: diffmod
+      real :: xdiffmod
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      End If
+C
+      IF (coeffraf .NE.3) THEN
+      print *,'LINEARCONSERVLIM not ready for refinement ratio = ',
+     &   coeffraf
+      stop
+      ENDIF   
+      
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1        
+
+      xdiffmod = real(diffmod)/2.
+                         
+      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+C
+      ypos = s_child  
+C      
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+
+      locind_parent_last = 1 +
+     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+     
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
+      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
+      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+      i = i1
+      
+      if (locind_parent_left == 1) then
+        slope=0.       
+      else
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf    
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo 
+
+        locind_parent_left = locind_parent_left + 1
+                      
+      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf     
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+      enddo
+      
+      i = i2
+      
+      if (locind_parent_left == np) then
+        slope=0.     
+      else
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf      
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,nc
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo      
+C
+      y(1:nc)=ytemp(1:nc)                                   
+C           
+      deallocate(ytemp)
+      Return
+C       
+      End Subroutine Linear1dconservlim      
+C         
+
+C     **************************************************************************  
+CCC   Subroutine ppm1d
+C     ************************************************************************** 
+C 
+      Subroutine ppm1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, INTENT(IN),Dimension(np) :: x      
+      Real, INTENT(OUT),Dimension(nc) :: y
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+C      
+
+      IF( .NOT. allocated(tabtest4) ) THEN    
+      Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+      ELSE
+         IF (size(tabtest4) .LT. nc+4*coeffraf+1)THEN
+         deallocate( tabtest4 )
+         Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+         ENDIF
+      ENDIF
+            
+      ypos = s_child  
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) 
+     &      *ds_child - s_parent)/ds_parent)  
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+C     
+C
+      
+!CDIR NOVECTOR
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2 
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR NOVECTOR
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+C
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+      Do i = nmin,nmax
+         slope(i) = x(i) - x(i-1)
+      Enddo
+
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+      Do i = nmin+1,nmax-1
+         xl(i)= 0.5*(x(i-1)+x(i))
+     &      -0.08333333333333*(slope(i+1)-slope(i-1)) 
+      Enddo
+C
+C apply parabolic monotonicity
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+       Do i = locind_parent_left,locind_parent_last
+          delta(i) = xl(i+1) - xl(i)
+          a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
+C
+       End do   
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C
+               tabtest4(jj) = xl(iparent)   
+     &             + tabdiff2(pos) *  (delta(iparent)+a6(iparent))
+     &             - tabdiff3(pos) *  a6(iparent)
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do
+C
+C
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        y(1:nc)=tabtest4(1:nc)
+        
+      Return
+      End Subroutine ppm1d
+      
+
+      Subroutine ppm1dprecompute2d(np2,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to compute 2D coefficients and index for a 1D interpolation
+CCC   using piecewise parabolic method  
+CC    Method: 
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np2,np,nc,dir
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer, Dimension(:,:), Allocatable :: indparent_tmp
+      Integer, Dimension(:,:), Allocatable :: indchild_tmp
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xl,delta,a6,slope
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      invcoeffraf = ds_child/ds_parent
+C 
+
+      if (.not.allocated(indparentppm)) then
+      allocate(
+     & indparentppm(np2*nc,3),
+     & indchildppm(np2*nc,3)
+     &        )
+      else
+      if (size(indparentppm,1)<np2*nc) then
+      allocate(
+     &  indparent_tmp(size(indparentppm,1),size(indparentppm,2)),
+     &  indchild_tmp(size(indparentppm,1),size(indparentppm,2)))
+      indparent_tmp = indparentppm 
+      indchild_tmp  = indchildppm 
+      deallocate(indparentppm,indchildppm)
+      allocate(
+     &indparentppm(np2*nc,3),
+     &indchildppm(np2*nc,3)
+     &        )
+      indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indparent_tmp
+      indchildppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indchild_tmp
+      deallocate(indparent_tmp,indchild_tmp)
+      endif
+      endif
+
+      if (.not.allocated(indparentppm_1d)) then
+      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
+     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
+      else
+      if (size(indparentppm_1d)<nc+4*coeffraf+1) then
+      deallocate(indparentppm_1d,indchildppm_1d)
+      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
+     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
+      endif
+      endif
+
+
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+C
+
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR ALTCODE
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+
+!CDIR ALTCODE
+      Do i=1,coeffraf
+      tabppm(1,i,dir) = 0.08333333333333*
+     &              (-1.+4*tabdiff2(i)-3*tabdiff3(i))
+      tabppm(2,i,dir) = 0.08333333333333*
+     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(3,i,dir) = 0.08333333333333*
+     &              (7.+30*tabdiff2(i)-30*tabdiff3(i))
+      tabppm(4,i,dir) = 0.08333333333333*
+     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(5,i,dir) = 0.08333333333333*
+     &              (2*tabdiff2(i)-3*tabdiff3(i))                   
+      End Do
+C 
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last
+             pos=1
+!CDIR ALTCODE
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+         indparentppm_1d(jj) = iparent-2
+         indchildppm_1d(jj) = pos
+               pos = pos+1
+             End do
+             ipos = ipos + coeffraf
+C
+        End do
+     
+       Do i=1,np2
+
+       indparentppm(1+(i-1)*nc:i*nc,dir) = 
+     &             indparentppm_1d(1:nc) + (i-1)*np
+       indchildppm (1+(i-1)*nc:i*nc,dir) = 
+     &             indchildppm_1d (1:nc) 
+
+       End do
+
+      Return
+      End Subroutine ppm1dprecompute2d
+
+
+      Subroutine ppm1dprecompute(np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to compute coefficient and index for  a 1D interpolation 
+CCC   using piecewise parabolic method  
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+C 
+      
+      if (.not.allocated(indparentppm)) then
+      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
+     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+      else
+      if (size(indparentppm,1)<nc+4*coeffraf+1) then
+      deallocate(indparentppm,indchildppm)
+      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
+     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+      endif
+      endif
+            
+      ypos = s_child  
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) 
+     &      *ds_child - s_parent)/ds_parent)  
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+C     
+C
+      
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2 
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR ALTCODE
+!!!CDIR SHORTLOOP
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+      
+!CDIR ALTCODE
+!!!CDIR SHORTLOOP
+      Do i=1,coeffraf
+      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+      tabppm(2,i,1) = 0.08333333333333*
+     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+      tabppm(4,i,1) = 0.08333333333333*
+     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))     
+      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i)) 
+      End Do   
+C 
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+         indparentppm(jj,1) = iparent-2
+         indchildppm(jj,1) = pos
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do
+        
+      Return
+      End Subroutine ppm1dprecompute
+      
+      Subroutine ppm1daftercompute(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method: Use precomputed coefficient and index
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc,dir
+      Real, INTENT(IN),Dimension(np) :: x      
+      Real, INTENT(OUT),Dimension(nc) :: y
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+      INTEGER :: diffmod
+C      
+C
+      do i=1,nc
+      y(i)=tabppm(1,indchildppm(i,dir),dir)*x(indparentppm(i,dir))+
+     &        tabppm(2,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+1)+
+     &        tabppm(3,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+2)+
+     &        tabppm(4,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+3)+
+     &        tabppm(5,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+4)
+      enddo
+        
+      Return
+      End Subroutine ppm1daftercompute            
+      
+C     **************************************************************************  
+CCC   Subroutine weno1d
+C     ************************************************************************** 
+C 
+      Subroutine weno1dnew(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+      Real, Dimension(np) :: x
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+      integer :: s,l,k
+      integer :: etan, etap
+      real :: delta0, delta1, delta2
+      real :: epsilon
+      parameter (epsilon = 1.D-8)
+      real, dimension(:,:), allocatable :: ak, ck
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+      Allocate(ak(0:1,coeffraf))
+      Allocate(ck(0:1,coeffraf))
+            
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+C      
+      diff(1)=0.5*invcoeffraf
+      do i=2,coeffraf
+         diff(i) = diff(i-1)+invcoeffraf
+      enddo
+      
+      ak = 0.
+      ck = 0.
+      
+      do i=1,coeffraf
+         do k=0,1
+         do s=0,2
+         do l=0,2
+           if (l /= s) then
+            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
+           endif
+         enddo
+         enddo
+         enddo
+               
+         etap = 0
+         etan = 0
+         do k=0,1
+          if (ak(k,i) > 0) then
+            etap = etap+1
+          else if (ak(k,i) < 0) then
+            etan = etan + 1
+          endif
+         enddo
+               
+         do k=0,1
+           if (ak(k,i) == 0) then
+            Ck(k,i) = 1.
+           else if (ak(k,i) > 0) then
+            Ck(k,i) = 1./(etap * ak(k,i))
+           else
+            Ck(k,i) = -1./(etan * ak(k,i))
+           endif
+         enddo
+      enddo
+                     
+C      
+      a = 0.
+      b = invcoeffraf
+      Do i=1,coeffraf
+         diff2(i) = 0.5*(b*b - a*a)  
+         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+         a = a + invcoeffraf
+         b = b + invcoeffraf
+      End do
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      elseif( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-2 >= 1) then
+          nmin = locind_parent_left-2
+      elseif(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+      Do i = nmin+1,nmax
+         slope(i) = (x(i) - x(i-1))
+      Enddo 
+      DO i=nmin+2,nmax
+        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)
+     &       +(slope(i)-slope(i-1))**2
+      enddo
+C
+        diffmod = 0
+        IF (mod(coeffraf,2) == 0) diffmod = 1           
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+             
+            delta0=1./(epsilon+smooth(iparent  ))**3
+            delta1=1./(epsilon+smooth(iparent+1))**3
+            delta2=1./(epsilon+smooth(iparent+2))**3   
+                      
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do     
+C
+C
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff, diff2, diff3)
+        
+        deallocate(ak,ck)
+        
+      Return
+      End Subroutine weno1dnew
+      
+C     **************************************************************************  
+CCC   Subroutine weno1d
+C     ************************************************************************** 
+C 
+      Subroutine weno1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+      Real, Dimension(np) :: x
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+      integer :: s,l,k
+      integer :: etan, etap
+      real :: delta0, delta1,sumdelta
+      real :: epsilon
+      parameter (epsilon = 1.D-8)
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+            
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+      Allocate( diff(coeffraf))
+C      
+      diff(1)=0.5*invcoeffraf
+      do i=2,coeffraf
+         diff(i) = diff(i-1)+invcoeffraf
+      enddo
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2   
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+      Do i = nmin+1,nmax
+         slope(i) = (x(i) - x(i-1))
+      Enddo 
+C
+        diffmod = 0
+        IF (mod(coeffraf,2) == 0) diffmod = 1           
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+            delta0=1./(epsilon+slope(iparent  )**2)**2
+            delta1=1./(epsilon+slope(iparent+1)**2)**2
+            sumdelta = 1./(delta0+delta1)             
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C                              
+          ytemp(jj) = x(iparent)+(diff(pos)-0.5)*(
+     &                delta0*slope(iparent)+
+     &                delta1*slope(iparent+1))*sumdelta
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do     
+C
+C
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff)
+        
+      Return
+      End Subroutine weno1d
+                 
+C                              
+C     **************************************************************************  
+CCC   Subroutine eno1d
+C     ************************************************************************** 
+C 
+      Subroutine eno1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   ---- p 163-164 Computational gasdynamics ----
+CCC   Subroutine to do a 1D interpolation 
+CCC   using piecewise polynomial ENO reconstruction technique  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: ipos,pos
+      Real    :: ypos,xi
+      integer :: i1,jj
+      Real :: xpmin,cavg
+C 
+      Real, Dimension(3,np) :: dd,c
+      Integer :: left
+C           
+      Real, DImension(1:np+1) :: xhalf
+      Real, Dimension(:,:),Allocatable  :: Xbar 
+      INTEGER :: diffmod     
+C
+      coeffraf = nint(ds_parent/ds_child)
+C      
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If     
+      
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1  
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child  
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) *ds_child - 
+     &      s_parent)/ds_parent)       
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)           
+C      
+      xhalf(np+1) = np + 0.5
+      Do i = 1,np
+          xhalf(i) = i - 0.5
+      Enddo
+C
+C compute divided differences
+C
+      dd(1,1:np) = x(1:np)
+      dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
+      dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
+C
+      Allocate( Xbar( coeffraf,2 ) )
+      xi = 0.5
+      Do i = 1,coeffraf
+        Xbar(i,1) = (i-1)*ds_child/ds_parent - xi
+        Xbar(i,2) = i*ds_child/ds_parent - xi
+      Enddo
+C
+      ipos = i1
+C           
+      DO i = locind_parent_left,locind_parent_last           
+         left = i           
+         do jj = 2,3
+             If(abs(dd(jj,left)) .gt. abs(dd(jj,left-1)))
+     &               left = left-1            
+         enddo
+C           
+C  convert to Taylor series form
+C
+         Call Taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
+      ENDDO     
+C
+C evaluate the reconstruction on each cell
+C
+       DO i = locind_parent_left,locind_parent_last  
+C
+         cavg = 0.
+         pos = 1.            
+C         
+         Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+           ytemp(jj) =(c(1,i)*(Xbar(pos,2)-Xbar(pos,1))
+     &                +c(2,i)*(Xbar(pos,2)*Xbar(pos,2)-
+     &                         Xbar(pos,1)*Xbar(pos,1))
+     &                +c(3,i)*(Xbar(pos,2)*Xbar(pos,2)*Xbar(pos,2)-
+     &                         Xbar(pos,1)*Xbar(pos,1)*Xbar(pos,1)))
+     &                         *coeffraf
+           cavg = cavg + ytemp(jj)
+           pos = pos+1
+         Enddo                
+         ipos = ipos + coeffraf                 
+      ENDDO
+C
+      y(1:nc)=ytemp(1:nc)                                            
+      deallocate(ytemp,Xbar)                 
+C      
+      Return       
+      End Subroutine eno1d
+C 
+C      
+C     **************************************************************************  
+CCC   Subroutine taylor
+C     ************************************************************************** 
+C       
+      subroutine taylor(ind,xhalf,dd,c)      
+C      
+      Integer :: ind
+      real,dimension(3) :: dd,c     
+      real,dimension(0:3,0:3) :: d 
+      real,dimension(3) :: xhalf    
+      integer ::i,j
+C      
+C
+      d(0,0:3)=1.
+      do i = 1,3
+         d(i,0)=(ind-xhalf(i))*d(i-1,0)
+      enddo  
+C      
+      do i = 1,3
+         do j = 1,3-i
+           d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
+         enddo
+      enddo
+C         
+      do j = 1,3        
+         c(j) = 0.
+         do i=0,3-j
+            c(j) = c(j) + d(i,j)*dd(i+j)         
+         enddo
+      enddo
+C      
+      end subroutine taylor    
+      
+      
+      REAL FUNCTION vanleer(tab)
+      REAL, DIMENSION(3) :: tab
+       real res1
+       real p1,p2,p3
+       
+       p1=(tab(3)-tab(1))/2.
+       p2=2.*(tab(2)-tab(1))
+       p3=2.*(tab(3)-tab(2))
+       
+       if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
+          res1=minval((/p1,p2,p3/))
+       elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
+          res1=maxval((/p1,p2,p3/))
+       else
+          res1=0.
+       endif
+          
+          vanleer = res1   
+      
+      
+      END FUNCTION vanleer 
+
+C      
+      End Module Agrif_Interpbasic
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 10250)
+++ 	(revision )
@@ -1,1464 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_InterpBasic
-!>
-!> Contains different procedures of interpolation (linear,lagrange, spline,...) used in
-!! the Agrif_Interpolation module.
-!
-module Agrif_InterpBasic
-!
-    use Agrif_Types
-!
-    implicit none
-!
-    real, dimension(5,Agrif_MaxRaff,3)      :: tabppm
-    real, dimension(Agrif_MaxRaff)          :: tabdiff2, tabdiff3
-    real, dimension(:),   allocatable       :: tabtest4
-    real, dimension(:,:), allocatable       :: coeffparent
-    integer, dimension(:,:), allocatable    :: indparent
-    integer, dimension(:,:), allocatable    :: indparentppm, indchildppm
-    integer, dimension(:), allocatable      :: indparentppm_1d, indchildppm_1d
-!
-    private :: Agrif_limiter_vanleer
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_basicinterp_linear1D
-!
-!> Linear 1D interpolation on a child grid (vector y) from its parent grid (vector x).
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_basicinterp_linear1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    real, dimension(np), intent(in)     :: x            !< Coarse input data from parent
-    real, dimension(nc), intent(out)    :: y            !< Fine output data to child
-    integer,             intent(in)     :: np           !< Length of input array
-    integer,             intent(in)     :: nc           !< Length of output array
-    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
-    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
-    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
-    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
-!
-    integer :: i, coeffraf, locind_parent_left
-    real    :: globind_parent_left, globind_parent_right
-    real    :: invds, invds2, ypos, ypos2, diff
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    if ( coeffraf == 1 ) then
-        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-        return
-    endif
-!
-    ypos = s_child
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-    globind_parent_left  = s_parent + (locind_parent_left - 1)*ds_parent
-    globind_parent_right = globind_parent_left + ds_parent
-!
-    invds  = 1./ds_parent
-    invds2 = ds_child/ds_parent
-    ypos2 = ypos*invds
-    globind_parent_right = globind_parent_right*invds
-!
-    do i = 1,nc-1
-!
-        if (ypos2 > globind_parent_right) then
-            locind_parent_left = locind_parent_left + 1
-            globind_parent_right = globind_parent_right + 1.
-            ypos2 = ypos*invds+(i-1)*invds2
-        endif
-!
-        diff = globind_parent_right - ypos2
-        y(i) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1))
-        ypos2 = ypos2 + invds2
-!
-    enddo
-!
-    ypos = s_child + (nc-1)*ds_child
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-!
-    if (locind_parent_left == np) then
-        y(nc) = x(np)
-    else
-        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
-        y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left)  &
-                           + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_basicinterp_linear1D
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Linear1dPrecompute2d
-!
-!> Computes 2D coefficients and index for a linear 1D interpolation on a child grid (vector y)
-!! from its parent grid (vector x).
-!---------------------------------------------------------------------------------------------------
-subroutine Linear1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: np,nc,np2
-    real,    intent(in) :: s_parent, s_child
-    real,    intent(in) :: ds_parent, ds_child
-    integer, intent(in) :: dir
-!
-    integer :: i,coeffraf,locind_parent_left,inc,inc1,inc2
-    integer, dimension(:,:), allocatable :: indparent_tmp
-    real, dimension(:,:), allocatable :: coeffparent_tmp
-    real    :: ypos,globind_parent_left,globind_parent_right
-    real    :: invds, invds2, invds3
-    real :: ypos2,diff
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    ypos = s_child
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-    globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
-    globind_parent_right = globind_parent_left + ds_parent
-!
-    invds = 1./ds_parent
-    invds2 = ds_child/ds_parent
-    invds3 = 0.5/real(coeffraf)
-    ypos2 = ypos*invds
-    globind_parent_right=globind_parent_right*invds
-!
-    if (.not.allocated(indparent)) then
-        allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
-    else
-        if ( size(indparent,1) < nc*np2 ) then
-            allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
-            allocate(  indparent_tmp(size(indparent,1),size(indparent,2)))
-            coeffparent_tmp = coeffparent
-            indparent_tmp   = indparent
-            deallocate(indparent,coeffparent)
-            allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
-            coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2)) = coeffparent_tmp
-            indparent(  1:size(indparent_tmp,  1),1:size(indparent_tmp,  2)) = indparent_tmp
-            deallocate(indparent_tmp,coeffparent_tmp)
-        endif
-    endif
-!
-    do i = 1,nc-1
-!
-        if (ypos2 > globind_parent_right) then
-            locind_parent_left = locind_parent_left + 1
-            globind_parent_right = globind_parent_right + 1.
-            ypos2 = ypos*invds+(i-1)*invds2
-        endif
-!
-        diff = globind_parent_right - ypos2
-        diff = invds3*nint(2*coeffraf*diff)
-        indparent(i,dir) = locind_parent_left
-        coeffparent(i,dir) = diff
-        ypos2 = ypos2 + invds2
-!
-    enddo
-!
-    ypos = s_child + (nc-1)*ds_child
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-    if (locind_parent_left == np) then
-        indparent(nc,dir) = locind_parent_left-1
-        coeffparent(nc,dir) = 0.
-    else
-        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
-        indparent(nc,dir) = locind_parent_left
-        diff = (globind_parent_left + ds_parent - ypos) * invds
-        diff = invds3*nint(2*coeffraf*diff)
-        coeffparent(nc,dir) = diff
-    endif
-
-    do i=2, np2
-        inc  =  i*nc
-        inc1 = (i-1)*nc
-        inc2 = (i-2)*nc
-!CDIR ALTCODE
-        indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
-!CDIR ALTCODE
-        coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Linear1dPrecompute2d
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Linear1dAfterCompute
-!
-!> Carries out a linear 1D interpolation on a child grid (vector y) from its parent grid (vector x)
-!! using precomputed coefficient and index.
-!---------------------------------------------------------------------------------------------------
-subroutine Linear1dAfterCompute ( x, y, np, nc, dir )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np, nc
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    integer,             intent(in)     :: dir
-!
-    integer :: i
-!
-!CDIR ALTCODE
-!CDIR NODEP
-    do i = 1,nc
-        y(i) = coeffparent(i,dir)  * x(MAX(indparent(i,dir),1)) + &
-           (1.-coeffparent(i,dir)) * x(indparent(i,dir)+1)
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Linear1dAfterCompute
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Lagrange1d
-!
-!> Carries out a lagrange 1D interpolation on a child grid (vector y) from its parent grid
-!! (vector x).
-!---------------------------------------------------------------------------------------------------
-subroutine Lagrange1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np, nc
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
-!
-    integer :: i, coeffraf, locind_parent_left
-    real    :: ypos,globind_parent_left
-    real    :: deltax, invdsparent
-    real    :: t2,t3,t4,t5,t6,t7,t8
-!
-    if (np <= 2) then
-        call Agrif_basicinterp_linear1D(x,y,np,nc,s_parent,s_child,ds_parent,ds_child)
-        return
-    endif
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    if (coeffraf == 1) then
-        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-        return
-    endif
-!
-    invdsparent = 1./ds_parent
-    ypos = s_child
-!
-    do i = 1,nc
-!
-        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
-
-        deltax = invdsparent*(ypos-globind_parent_left)
-        deltax = nint(coeffraf*deltax)/real(coeffraf)
-
-        ypos = ypos + ds_child
-        if (abs(deltax) <= 0.0001) then
-            y(i)=x(locind_parent_left)
-            cycle
-        endif
-!
-        t2 = deltax - 2.
-        t3 = deltax - 1.
-        t4 = deltax + 1.
-
-        t5 = -(1./6.)*deltax*t2*t3
-        t6 = 0.5*t2*t3*t4
-        t7 = -0.5*deltax*t2*t4
-        t8 = (1./6.)*deltax*t3*t4
-
-        y(i) = t5*x(locind_parent_left-1) + t6*x(locind_parent_left)    &
-              +t7*x(locind_parent_left+1) + t8*x(locind_parent_left+2)
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Lagrange1d
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Constant1d
-!
-!> Carries out a constant 1D interpolation on a child grid (vector y) from its parent grid (vector x).
-!---------------------------------------------------------------------------------------------------
-subroutine Constant1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np, nc
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
-!
-    integer :: i, coeffraf, locind_parent
-    real    :: ypos
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    if (coeffraf == 1) then
-        locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
-        y(1:nc) = x(locind_parent:locind_parent+nc-1)
-        return
-    endif
-!
-    ypos = s_child
-!
-    do i = 1,nc
-!
-        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
-        y(i) = x(locind_parent)
-        ypos = ypos + ds_child
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Constant1d
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Linear1dConserv
-!
-!> Carries out a conservative linear 1D interpolation on a child grid (vector y) from its parent 
-!! grid (vector x).
-!---------------------------------------------------------------------------------------------------
-subroutine Linear1dConserv ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np, nc
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
-!
-    real, dimension(:), allocatable :: ytemp
-    integer :: i,coeffraf,locind_parent_left,locind_parent_last
-    real    :: ypos,xdiffmod,xpmin,xpmax,slope
-    integer :: i1,i2,ii
-    integer :: diffmod
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    if (coeffraf == 1) then
-        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-        return
-    endif
-!
-    diffmod = 0
-    if (mod(coeffraf,2) == 0) diffmod = 1
-
-    xdiffmod = real(diffmod)/2.
-
-    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-!
-    ypos = s_child
-!
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
-
-    xpmin = s_parent + (locind_parent_left-1)*ds_parent
-    xpmax = s_parent + (locind_parent_last-1)*ds_parent
-
-    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-    i2 = 1+agrif_int((xpmax-s_child)/ds_child)
-
-    i = i1
-
-    if (locind_parent_left == 1) then
-        slope = (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
-    else
-        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-    endif
-
-    do ii = i-coeffraf/2+diffmod,i+coeffraf/2
-        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-    enddo
-
-    locind_parent_left = locind_parent_left + 1
-
-    do i = i1+coeffraf, i2-coeffraf,coeffraf
-        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-        do ii = i-coeffraf/2+diffmod,i+coeffraf/2
-            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo
-        locind_parent_left = locind_parent_left + 1
-    enddo
-
-    i = i2
-
-    if (locind_parent_left == np) then
-        slope = (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
-    else
-        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-    endif
-
-    do ii = i-coeffraf/2+diffmod,nc
-        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-    enddo
-!
-    y(1:nc)=ytemp(1:nc)
-!
-    deallocate(ytemp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Linear1dConserv
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Linear1dConservLim
-!
-!> Carries out a limited conservative linear 1D interpolation on a child grid (vector y) from
-!! its parent grid (vector x).
-!---------------------------------------------------------------------------------------------------
-subroutine Linear1dConservLim ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np, nc
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
-!
-    real, dimension(:), allocatable :: ytemp
-    integer :: i,coeffraf,locind_parent_left,locind_parent_last
-    real    :: ypos,xdiffmod,xpmin,xpmax,slope
-    integer :: i1,i2,ii
-    integer :: diffmod
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    if (coeffraf == 1) then
-        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-        return
-    endif
-!
-    if (coeffraf /= 3) then
-        print *,'Linear1dConservLim not ready for refinement ratio = ', coeffraf
-        stop
-    endif
-!
-    diffmod = 0
-    if (mod(coeffraf,2) == 0) diffmod = 1
-
-    xdiffmod = real(diffmod)/2.
-
-    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-!
-    ypos = s_child
-!
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
-
-    xpmin = s_parent + (locind_parent_left-1)*ds_parent
-    xpmax = s_parent + (locind_parent_last-1)*ds_parent
-
-    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-    i2 = 1+agrif_int((xpmax-s_child)/ds_child)
-
-    i = i1
-
-    if (locind_parent_left == 1) then
-        slope=0.
-    else
-        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf
-    endif
-
-    do ii = i-coeffraf/2+diffmod,i+coeffraf/2
-        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-    enddo
-
-    locind_parent_left = locind_parent_left + 1
-
-    do i = i1+coeffraf, i2-coeffraf,coeffraf
-        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo
-        locind_parent_left = locind_parent_left + 1
-    enddo
-
-    i = i2
-
-    if (locind_parent_left == np) then
-        slope=0.
-    else
-        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf
-    endif
-
-    do ii=i-coeffraf/2+diffmod,nc
-        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-    enddo
-!
-    y(1:nc) = ytemp(1:nc)
-!
-    deallocate(ytemp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Linear1dConservLim
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine PPM1d
-!
-!> Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic
-!! method (PPM) on a child grid (vector y) from its parent grid (vector x).
-!---------------------------------------------------------------------------------------------------
-subroutine PPM1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np, nc
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
-!
-    integer :: i,coeffraf,locind_parent_left,locind_parent_last
-    integer :: iparent,ipos,pos,nmin,nmax
-    real    :: ypos
-    integer :: i1,jj
-    real :: xpmin,a
-!
-    real, dimension(np) :: xl,delta,a6,slope
-    integer :: diffmod
-    real :: invcoeffraf
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    if (coeffraf == 1) then
-        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-        return
-    endif
-!
-    invcoeffraf = ds_child/ds_parent
-!
-    if( .not. allocated(tabtest4) ) then
-        allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
-    else
-        if (size(tabtest4) < nc+4*coeffraf+1) then
-            deallocate( tabtest4 )
-            allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
-        endif
-    endif
-!
-    ypos = s_child
-!
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent)
-!
-    xpmin = s_parent + (locind_parent_left-1)*ds_parent
-    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-!
-!CDIR NOVECTOR
-    do i=1,coeffraf
-        tabdiff2(i) = (real(i)-0.5)*invcoeffraf
-    enddo
-!
-    a = invcoeffraf**2
-    tabdiff3(1) = (1./3.)*a
-    a = 2.*a
-!CDIR NOVECTOR
-    do i=2,coeffraf
-        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-    enddo
-!
-    if      ( locind_parent_last+2 <= np ) then
-        nmax = locind_parent_last+2
-    else if ( locind_parent_last+1 <= np ) then
-        nmax = locind_parent_last+1
-    else
-        nmax = locind_parent_last
-    endif
-!
-    if (locind_parent_left-1 >= 1) then
-        nmin = locind_parent_left-1
-    else
-        nmin = locind_parent_left
-    endif
-!
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-    do i = nmin,nmax
-        slope(i) = x(i) - x(i-1)
-    enddo
-!
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-    do i = nmin+1,nmax-1
-        xl(i)= 0.5*(x(i-1)+x(i))-0.08333333333333*(slope(i+1)-slope(i-1))
-    enddo
-!
-! apply parabolic monotonicity
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-    do i = locind_parent_left,locind_parent_last
-        delta(i) = xl(i+1) - xl(i)
-        a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
-    enddo
-!
-    diffmod = 0
-    if (mod(coeffraf,2) == 0) diffmod = 1
-!
-    ipos = i1
-!
-    do iparent = locind_parent_left,locind_parent_last
-        pos=1
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-        do jj = ipos-coeffraf/2+diffmod,ipos+coeffraf/2
-!
-            tabtest4(jj) = xl(iparent) + tabdiff2(pos) *  (delta(iparent)+a6(iparent)) &
-                                       - tabdiff3(pos) *  a6(iparent)
-            pos = pos+1
-        enddo
-        ipos = ipos + coeffraf
-    enddo
-!
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-    y(1:nc) = tabtest4(1:nc)
-!---------------------------------------------------------------------------------------------------
-end subroutine PPM1d
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine PPM1dPrecompute2d
-!
-!> Computes 2D coefficients and index for a 1D interpolation using piecewise parabolic method
-!---------------------------------------------------------------------------------------------------
-subroutine PPM1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np2, np, nc
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
-    integer,             intent(in)     :: dir
-!
-    integer, dimension(:,:), allocatable :: indparent_tmp
-    integer, dimension(:,:), allocatable :: indchild_tmp
-    integer :: i,coeffraf,locind_parent_left,locind_parent_last
-    integer :: iparent,ipos,pos
-    real    :: ypos
-    integer :: i1,jj
-    real :: xpmin,a
-!
-    integer :: diffmod
-    real :: invcoeffraf
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    invcoeffraf = ds_child/ds_parent
-!
-    if (.not.allocated(indparentppm)) then
-        allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3))
-    else
-        if (size(indparentppm,1) < np2*nc) then
-            allocate(   &
-                indparent_tmp(size(indparentppm,1),size(indparentppm,2)), &
-                indchild_tmp( size(indparentppm,1),size(indparentppm,2)))
-            indparent_tmp = indparentppm
-            indchild_tmp  = indchildppm
-            deallocate(indparentppm,indchildppm)
-            allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3))
-            indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indparent_tmp
-            indchildppm( 1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indchild_tmp
-            deallocate(indparent_tmp,indchild_tmp)
-        endif
-    endif
-
-    if (.not.allocated(indparentppm_1d)) then
-        allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),    &
-                 indchildppm_1d( -2*coeffraf:nc+2*coeffraf))
-    else
-        if (size(indparentppm_1d) < nc+4*coeffraf+1) then
-            deallocate(indparentppm_1d,indchildppm_1d)
-            allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),&
-                     indchildppm_1d( -2*coeffraf:nc+2*coeffraf))
-        endif
-    endif
-!
-    ypos = s_child
-!
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent)
-!
-    xpmin = s_parent + (locind_parent_left-1)*ds_parent
-    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-!
-    do i = 1,coeffraf
-        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-    enddo
-!
-    a = invcoeffraf**2
-    tabdiff3(1) = (1./3.)*a
-    a = 2.*a
-!CDIR ALTCODE
-    do i = 2,coeffraf
-        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-    enddo
-
-!CDIR ALTCODE
-    do i = 1,coeffraf
-        tabppm(1,i,dir) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
-        tabppm(2,i,dir) = 0.08333333333333*(7.-26.*tabdiff2(i)+18.*tabdiff3(i))
-        tabppm(3,i,dir) = 0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
-        tabppm(4,i,dir) = 0.08333333333333*(-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
-        tabppm(5,i,dir) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
-    enddo
-!
-    diffmod = 0
-    if (mod(coeffraf,2) == 0) diffmod = 1
-!
-    ipos = i1
-!
-    do iparent = locind_parent_left,locind_parent_last
-        pos=1
-!CDIR ALTCODE
-        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-            indparentppm_1d(jj) = iparent-2
-            indchildppm_1d(jj)  = pos
-            pos = pos+1
-        enddo
-        ipos = ipos + coeffraf
-    enddo
-!
-    do i = 1,np2
-        indparentppm(1+(i-1)*nc:i*nc,dir) = indparentppm_1d(1:nc) + (i-1)*np
-        indchildppm (1+(i-1)*nc:i*nc,dir) = indchildppm_1d (1:nc)
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine PPM1dPrecompute2d
-!===================================================================================================
-!
-!===================================================================================================
-!subroutine PPM1dPrecompute(np,nc,&
-!                    s_parent,s_child,ds_parent,ds_child)
-!!
-!!CC   Description:
-!!CC   subroutine to compute coefficient and index for  a 1D interpolation
-!!CC   using piecewise parabolic method
-!!C    Method:
-!!
-!!     Declarations:
-!!
-!      Implicit none
-!!
-!!     Arguments
-!      Integer             :: np,nc
-!!      Real, Dimension(:),Allocatable :: ytemp
-!      Real                :: s_parent,s_child,ds_parent,ds_child
-!!
-!!     Local scalars
-!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-!      Integer :: iparent,ipos,pos,nmin,nmax
-!      Real    :: ypos
-!      integer :: i1,jj
-!      Real :: xpmin,a
-!!
-!      Real :: xrmin,xrmax,am3,s2,s1
-!      Real, Dimension(np) :: xl,delta,a6,slope
-!!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
-!      INTEGER :: diffmod
-!      REAL :: invcoeffraf
-!!
-!      coeffraf = nint(ds_parent/ds_child)
-!!
-!      If (coeffraf == 1) Then
-!          return
-!      End If
-!      invcoeffraf = ds_child/ds_parent
-!!
-!
-!      if (.not.allocated(indparentppm)) then
-!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
-!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
-!      else
-!      if (size(indparentppm,1)<nc+4*coeffraf+1) then
-!      deallocate(indparentppm,indchildppm)
-!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
-!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
-!      endif
-!      endif
-!
-!      ypos = s_child
-!!
-!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-!      locind_parent_last = 1 +&
-!      agrif_ceiling((ypos +(nc - 1)&
-!      *ds_child - s_parent)/ds_parent)
-!!
-!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-!!
-!!
-!
-!      Do i=1,coeffraf
-!        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-!      EndDo
-!
-!      a = invcoeffraf**2
-!      tabdiff3(1) = (1./3.)*a
-!      a=2.*a
-!!CDIR ALTCODE
-!!!!CDIR SHORTLOOP
-!      Do i=2,coeffraf
-!        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-!      EndDo
-!
-!!CDIR ALTCODE
-!!!!CDIR SHORTLOOP
-!      Do i=1,coeffraf
-!      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
-!      tabppm(2,i,1) = 0.08333333333333*&
-!              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
-!      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
-!      tabppm(4,i,1) = 0.08333333333333*&
-!              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
-!      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
-!      End Do
-!!
-!!
-!        diffmod = 0
-!       IF (mod(coeffraf,2) == 0) diffmod = 1
-!!
-!        ipos = i1
-!!
-!        Do iparent = locind_parent_left,locind_parent_last
-!             pos=1
-!!CDIR ALTCODE
-!!CDIR SHORTLOOP
-!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-!         indparentppm(jj,1) = iparent-2
-!         indchildppm(jj,1) = pos
-!               pos = pos+1
-!             End do
-!             ipos = ipos + coeffraf
-!!
-!        End do
-!
-!      Return
-!      End subroutine ppm1dprecompute
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine PPM1dAfterCompute
-!
-! Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic
-! method (PPM) on a child grid (vector y) from its parent grid (vector x).
-! Use precomputed coefficient and index.
-!---------------------------------------------------------------------------------------------------
-subroutine PPM1dAfterCompute ( x, y, np, nc, dir )
-!---------------------------------------------------------------------------------------------------
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    integer,             intent(in)     :: np, nc
-    integer,             intent(in)     :: dir
-!
-    integer :: i
-!
-    do i = 1,nc
-        y(i) = tabppm(1,indchildppm(i,dir),dir) * x(indparentppm(i,dir)  ) + &
-               tabppm(2,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+1) + &
-               tabppm(3,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+2) + &
-               tabppm(4,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+3) + &
-               tabppm(5,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+4)
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine PPM1dAfterCompute
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine weno1d
-!
-! Carries out a 1D interpolation and apply monotonicity constraints
-! using WENO method on a child grid (vector y) from its parent grid (vector x).
-!---------------------------------------------------------------------------------------------------
-!subroutine weno1dnew ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-!
-!CC   Description:
-!CC   subroutine to do a 1D interpolation and apply monotonicity constraints
-!CC   using piecewise parabolic method
-!CC   on a child grid (vector y) from its parent grid (vector x).
-!C    Method:
-!
-!     Declarations:
-!
-!      Implicit none
-!
-!     Arguments
-!      Integer             :: np,nc
-!      Real, Dimension(np) :: x
-!      Real, Dimension(nc) :: y
-!      Real, Dimension(:),Allocatable :: ytemp
-!      Real                :: s_parent,s_child,ds_parent,ds_child
-!
-!     Local scalars
-!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-!      Integer :: iparent,ipos,pos,nmin,nmax
-!      Real    :: ypos
-!      integer :: i1,jj
-!      Real :: xpmin,cavg,a,b
-!
-!      Real :: xrmin,xrmax,am3,s2,s1
-!      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
-!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
-!      INTEGER :: diffmod
-!      REAL :: invcoeffraf
-!      integer :: s,l,k
-!      integer :: etan, etap
-!      real :: delta0, delta1, delta2
-!      real :: epsilon
-!      parameter (epsilon = 1.D-8)
-!      real, dimension(:,:), allocatable :: ak, ck
-!
-!      coeffraf = nint(ds_parent/ds_child)
-!
-!      If (coeffraf == 1) Then
-!          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-!          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-!          return
-!      End If
-!      invcoeffraf = ds_child/ds_parent
-!      Allocate(ak(0:1,coeffraf))
-!      Allocate(ck(0:1,coeffraf))
-!
-!
-!      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-!      ypos = s_child
-!
-!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-!      locind_parent_last = 1 +&
-!      agrif_ceiling((ypos +(nc - 1)&
-!      *ds_child - s_parent)/ds_parent)
-!
-!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-!
-!      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
-!
-!      diff(1)=0.5*invcoeffraf
-!      do i=2,coeffraf
-!         diff(i) = diff(i-1)+invcoeffraf
-!      enddo
-!
-!      ak = 0.
-!      ck = 0.
-!
-!      do i=1,coeffraf
-!         do k=0,1
-!         do s=0,2
-!         do l=0,2
-!           if (l /= s) then
-!            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
-!           endif
-!         enddo
-!         enddo
-!         enddo
-!
-!         etap = 0
-!         etan = 0
-!         do k=0,1
-!          if (ak(k,i) > 0) then
-!            etap = etap+1
-!          else if (ak(k,i) < 0) then
-!            etan = etan + 1
-!          endif
-!         enddo
-!
-!         do k=0,1
-!           if (ak(k,i) == 0) then
-!            Ck(k,i) = 1.
-!           else if (ak(k,i) > 0) then
-!            Ck(k,i) = 1./(etap * ak(k,i))
-!           else
-!            Ck(k,i) = -1./(etan * ak(k,i))
-!           endif
-!         enddo
-!      enddo
-!
-!
-!      a = 0.
-!      b = invcoeffraf
-!      Do i=1,coeffraf
-!         diff2(i) = 0.5*(b*b - a*a)
-!         diff3(i) = (1./3.)*(b*b*b - a*a*a)
-!         a = a + invcoeffraf
-!         b = b + invcoeffraf
-!      End do
-!
-!      if( locind_parent_last+2 <= np ) then
-!           nmax = locind_parent_last+2
-!      elseif( locind_parent_last+1 <= np ) then
-!           nmax = locind_parent_last+1
-!      else
-!           nmax = locind_parent_last
-!      endif
-!
-!      if(locind_parent_left-2 >= 1) then
-!          nmin = locind_parent_left-2
-!      elseif(locind_parent_left-1 >= 1) then
-!          nmin = locind_parent_left-1
-!      else
-!          nmin = locind_parent_left
-!      endif
-!
-!      Do i = nmin+1,nmax
-!         slope(i) = (x(i) - x(i-1))
-!      Enddo
-!      DO i=nmin+2,nmax
-!        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)&
-!       +(slope(i)-slope(i-1))**2
-!      enddo
-!
-!        diffmod = 0
-!        IF (mod(coeffraf,2) == 0) diffmod = 1
-!
-!        ipos = i1
-!
-!        Do iparent = locind_parent_left,locind_parent_last
-!             pos=1
-!
-!            delta0=1./(epsilon+smooth(iparent  ))**3
-!            delta1=1./(epsilon+smooth(iparent+1))**3
-!            delta2=1./(epsilon+smooth(iparent+2))**3
-!
-!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-!
-!               pos = pos+1
-!             End do
-!             ipos = ipos + coeffraf
-!
-!        End do
-!
-!
-!        y(1:nc)=ytemp(1:nc)
-!        deallocate(ytemp)
-!        deallocate(diff, diff2, diff3)
-!
-!        deallocate(ak,ck)
-!
-!      Return
-!      End subroutine weno1dnew
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine WENO1d
-!
-!> Carries out a a 1D interpolation using WENO method on a child grid (vector y) from its parent 
-!! grid (vector x).
-!---------------------------------------------------------------------------------------------------
-subroutine WENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np, nc
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
-!
-    real, dimension(:), allocatable :: ytemp
-    integer :: i,coeffraf,locind_parent_left,locind_parent_last
-    integer :: iparent,ipos,pos,nmin,nmax
-    real    :: ypos
-    integer :: i1,jj
-    real :: xpmin
-!
-    real, dimension(np) :: slope
-    real, dimension(:), allocatable  :: diff
-    integer :: diffmod
-    real :: invcoeffraf
-    real :: delta0, delta1, sumdelta
-    real, parameter :: epsilon = 1.d-8
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    if (coeffraf == 1) then
-        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-        return
-    endif
-!
-    invcoeffraf = ds_child/ds_parent
-!
-    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-    ypos = s_child
-!
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
-!
-    xpmin = s_parent + (locind_parent_left-1)*ds_parent
-    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-!
-    allocate(diff(coeffraf))
-    diff(1) = 0.5*invcoeffraf
-    do i = 2,coeffraf
-        diff(i) = diff(i-1)+invcoeffraf
-    enddo
-!
-    if ( locind_parent_last+2 <= np ) then
-        nmax = locind_parent_last+2
-    else if ( locind_parent_last+1 <= np ) then
-        nmax = locind_parent_last+1
-      else
-        nmax = locind_parent_last
-    endif
-!
-    if(locind_parent_left-1 >= 1) then
-        nmin = locind_parent_left-1
-    else
-        nmin = locind_parent_left
-    endif
-!
-    do i = nmin+1,nmax
-        slope(i) = x(i) - x(i-1)
-    enddo
-!
-    diffmod = 0
-    if (mod(coeffraf,2) == 0) diffmod = 1
-!
-    ipos = i1
-!
-    do iparent = locind_parent_left,locind_parent_last
-        pos=1
-        delta0 = 1./(epsilon+slope(iparent  )**2)**2
-        delta1 = 1./(epsilon+slope(iparent+1)**2)**2
-        sumdelta = 1./(delta0+delta1)
-        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-            ytemp(jj) = x(iparent)+(diff(pos)-0.5)*( delta0*slope(iparent) + &
-                                                     delta1*slope(iparent+1))*sumdelta
-            pos = pos+1
-        enddo
-        ipos = ipos + coeffraf
-    enddo
-!
-    y(1:nc) = ytemp(1:nc)
-    deallocate(ytemp)
-    deallocate(diff)
-!---------------------------------------------------------------------------------------------------
-end subroutine WENO1d
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine ENO1d
-!
-!> Carries out a 1D interpolation using piecewise polynomial ENO reconstruction technique
-!! on a child grid (vector y) from its parent grid (vector x).
-!! \see ---- p 163-164 Computational gasdynamics ----
-!---------------------------------------------------------------------------------------------------
-subroutine ENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: np, nc
-    real, dimension(np), intent(in)     :: x
-    real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
-!
-    integer :: i,coeffraf,locind_parent_left,locind_parent_last
-    integer :: ipos, pos
-    real    :: ypos,xi
-    integer :: i1,jj
-    real :: xpmin
-!
-    real, dimension(:),   allocatable  :: ytemp
-    real, dimension(:,:), allocatable  :: xbar
-    real, dimension(1:np+1)            :: xhalf
-    real, dimension(3,np)              :: dd, c
-    integer :: diffmod, left
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    if (coeffraf == 1) then
-        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-        return
-    end if
-
-    diffmod = 0
-    if (mod(coeffraf,2) == 0) diffmod = 1
-!
-    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-    ypos = s_child
-!
-    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
-!
-    xpmin = s_parent + (locind_parent_left-1)*ds_parent
-    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-!
-    do i = 1,np+1
-        xhalf(i) = i - 0.5
-    enddo
-!
-! Compute divided differences
-!
-    dd(1,1:np)   = x(1:np)
-    dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
-    dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
-!
-    allocate( xbar( coeffraf,2 ) )
-    xi = 0.5
-    do i = 1,coeffraf
-        xbar(i,1) = (i-1)*ds_child/ds_parent - xi
-        xbar(i,2) =  i   *ds_child/ds_parent - xi
-    enddo
-!
-    ipos = i1
-!
-    do i = locind_parent_left,locind_parent_last
-        left = i
-        do jj = 2,3
-            if(abs(dd(jj,left)) > abs(dd(jj,left-1))) left = left-1
-        enddo
-!
-!       convert to Taylor series form
-        call taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
-    enddo
-!
-! Evaluate the reconstruction on each cell
-!
-    do i = locind_parent_left,locind_parent_last
-!
-        pos = 1
-!
-        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-            ytemp(jj) = ( c(1,i)*(xbar(pos,2)-xbar(pos,1))              &
-                        + c(2,i)*(xbar(pos,2)*xbar(pos,2) -             &
-                                  xbar(pos,1)*xbar(pos,1))              &
-                        + c(3,i)*(xbar(pos,2)*xbar(pos,2)*xbar(pos,2) - &
-                                  xbar(pos,1)*xbar(pos,1)*xbar(pos,1))  &
-                        ) * coeffraf
-            pos = pos+1
-        enddo
-        ipos = ipos + coeffraf
-!
-    enddo
-!
-    y(1:nc) = ytemp(1:nc)
-    deallocate(ytemp,xbar)
-!---------------------------------------------------------------------------------------------------
-end subroutine ENO1d
-!===================================================================================================
-!
-!     **************************************************************************  
-!CC   Subroutine ppm1d_lim
-!     ************************************************************************** 
-! 
-      Subroutine ppm1d_lim(x,y,np,nc,s_parent,s_child,ds_parent,ds_child) 
-!
-!CC   Description:
-!CC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-!CC   using piecewise parabolic method  
-!CC   on a child grid (vector y) from its parent grid (vector x).
-!C    Method:
-!
-!     Declarations:
-!
-      Implicit none
-!        
-!     Arguments
-      Integer             :: np,nc      
-      Real, Dimension(np) :: x      
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-!
-!     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,cavg,a,b
-!      
-      Real :: xrmin,xrmax,am3,s2,s1  
-      Real, Dimension(np) :: dela,xr,xl,delta,a6,slope,slope2
-      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
-      INTEGER :: diffmod
-!      
-      coeffraf = nint(ds_parent/ds_child)
-!
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If
-!      
-      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-      ypos = s_child  
-!
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-      locind_parent_last = 1 + &
-           agrif_ceiling((ypos +(nc - 1)  &
-           *ds_child - s_parent)/ds_parent)  
-!
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
-!     
-      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
-!      
-         diff(:) = ds_child/ds_parent
-!      
-      Do i=1,coeffraf
-         a = real(i-1)*ds_child/ds_parent
-         b = real(i)*ds_child/ds_parent
-         diff2(i) = 0.5*(b*b - a*a)  
-         diff3(i) = (1./3.)*(b*b*b - a*a*a)
-      End do
-!
-      if( locind_parent_last+2 <= np ) then
-           nmax = locind_parent_last+2    
-      else if( locind_parent_last+1 <= np ) then
-           nmax = locind_parent_last+1
-      else
-           nmax = locind_parent_last 
-      endif     
-!      
-      if(locind_parent_left-1 >= 1) then
-          nmin = locind_parent_left-1
-      else 
-          nmin = locind_parent_left
-      endif    
-! 
-      Do i = nmin,nmax
-         slope(i) = x(i) - x(i-1)
-         slope2(i) = 2.*abs(slope(i))
-      Enddo
-!
-      Do i = nmin,nmax-1
-         dela(i) = 0.5 * ( slope(i) + slope(i+1) )
-! Van Leer slope limiter
-         dela(i) = min( abs(dela(i)),slope2(i), &
-                       slope2(i+1) )*sign(1.,dela(i))
-         IF( slope(i)*slope(i+1) <= 0. ) dela(i) = 0.
-      Enddo
-!
-      Do i = nmin,nmax-2
-         xr(i) = x(i) + (1./2.)*slope(i+1) + (-1./6.)*dela(i+1) &
-                                          + ( 1./6. )*dela(i)
-      Enddo
-!
-      Do i = nmin,nmax-2
-         xrmin = min(x(i),x(i+1))
-         xrmax = max(x(i),x(i+1))
-         xr(i) = min(xr(i),xrmax)
-         xr(i) = max(xr(i),xrmin)
-         xl(i+1) = xr(i)         
-      Enddo
-! apply parabolic monotonicity
-       Do i = locind_parent_left,locind_parent_last
-          If( ( (xr(i)-x(i))* (x(i)-xl(i)) ) .le. 0. ) then
-             xl(i) = x(i) 
-             xr(i) = x(i)
-          Endif          
-          delta(i) = xr(i) - xl(i)
-          am3 = 3. * x(i)
-          s1  = am3 - 2. * xr(i)
-          s2  = am3 - 2. * xl(i)
-          IF( delta(i) * (xl(i) - s1) .le. 0. ) xl(i) = s1
-          IF( delta(i) * (s2 - xr(i)) .le. 0. ) xr(i) = s2
-          delta(i) = xr(i) - xl(i)
-          a6(i) = 6.*x(i)-3.*(xl(i) +xr(i))
-!
-       End do   
-!
-        diffmod = 0
-       IF (mod(coeffraf,2) == 0) diffmod = 1           
-!
-        ipos = i1
-!               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-             cavg = 0.
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-!
-               ytemp(jj) = (diff(pos)*xl(iparent)   &
-                  + diff2(pos) &
-                  *  (delta(iparent)+a6(iparent)) &
-                  - diff3(pos)*a6(iparent))*coeffraf
-                              
-               cavg = cavg + ytemp(jj)
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-!
-        End do     
-!
-!
-        y(1:nc)=ytemp(1:nc)                                 
-        deallocate(ytemp)                
-        deallocate(diff, diff2, diff3)
-      Return
-      End Subroutine ppm1d_lim
-!===================================================================================================
-!  subroutine taylor
-!---------------------------------------------------------------------------------------------------
-subroutine taylor ( ind, xhalf, dd, c )
-!---------------------------------------------------------------------------------------------------
-    integer,            intent(in)  :: ind
-    real, dimension(3), intent(in)  :: xhalf
-    real, dimension(3), intent(in)  :: dd
-    real, dimension(3), intent(out) :: c
-!
-    real, dimension(0:3,0:3) :: d
-    integer                  :: i, j
-!
-    d(0,0:3) = 1.0
-    do i = 1,3
-        d(i,0) = (ind-xhalf(i))*d(i-1,0)
-    enddo
-!
-    do i = 1,3
-        do j = 1,3-i
-            d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
-        enddo
-    enddo
-!
-    do j = 1,3
-        c(j) = 0.
-        do i=0,3-j
-            c(j) = c(j) + d(i,j)*dd(i+j)
-        enddo
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine taylor
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_limiter_vanleer
-!---------------------------------------------------------------------------------------------------
-real function Agrif_limiter_vanleer ( tab ) result(res)
-!---------------------------------------------------------------------------------------------------
-    real, dimension(3), intent(in) :: tab
-!
-    real :: p1, p2, p3
-
-    p1 =    (tab(3)-tab(1))/2.
-    p2 = 2.*(tab(2)-tab(1))
-    p3 = 2.*(tab(3)-tab(2))
-
-    if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
-        res = minval((/p1,p2,p3/))
-    elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
-        res = maxval((/p1,p2,p3/))
-    else
-        res=0.
-    endif
-!---------------------------------------------------------------------------------------------------
-end function Agrif_limiter_vanleer
-!===================================================================================================
-!
-end module Agrif_InterpBasic
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 10251)
@@ -0,0 +1,186 @@
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+      Module Agrif_link
+C
+CCC   Description:
+CCC   This module is used to link AGRIF files to the model
+C
+C     Modules used: 
+C
+c        external Agrif_InitValues
+c        external Agrif_detect
+C
+        external Agrif_InitWorkspace
+        external Agrif_probdim_modtype_def
+        external Agrif_clustering_def
+        external Agrif_comm_def
+C     Interface                       
+      INTERFACE
+      SUBROUTINE  Sub_Loop_Agrif_InvLoc(indloc,nprocloc,i,
+     &            indglob,njmppt,nimppt)
+      INTEGER :: indglob
+      INTEGER :: indloc
+      INTEGER :: nprocloc
+      INTEGER :: i
+
+      INTEGER, ALLOCATABLE, Dimension(:) :: njmppt
+      INTEGER, ALLOCATABLE, Dimension(:) :: nimppt
+      END SUBROUTINE
+      END INTERFACE
+      Interface
+         Subroutine Agrif_Set_numberofcells(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Set_numberofcells
+      End interface
+      Interface
+         Subroutine Agrif_Get_numberofcells(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Get_numberofcells
+      End interface
+      Interface
+         Subroutine Agrif_Allocationcalls(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Allocationcalls
+      End interface
+C   
+      End Module Agrif_link
+C     **************************************************************************
+CCC   Function Agrif_parent
+C        modify by conv. To use : un_parent = Agrif_Parent(un)
+C     **************************************************************************
+CCC   Function Agrif_Get_Coarse_Grid
+C        modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un)
+C     **************************************************************************
+CCC   Function Agrif_Rhox
+C        modify by conv. To use : var = Agrif_Rhox()
+C                    REAL(Agrif_Curgrid % spaceref(1))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhox
+C        modify by conv. To use : var = Agrif_Parent_Rhox()
+C                    REAL(Agrif_Curgrid % parent % spaceref(1))
+C     **************************************************************************
+CCC   Function Agrif_Irhox
+C        modify by conv. To use : var = Agrif_Parent_IRhox()
+C                    Agrif_Curgrid % spaceref(1)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhox
+C        modify by conv. To use : var = Agrif_Parent_IRhox()
+C                    Agrif_Curgrid % parent % spaceref(1)
+C     **************************************************************************
+CCC   Function Agrif_Rhoy
+C        modify by conv. To use : var = Agrif_Rhoy()
+C                    REAL(Agrif_Curgrid % spaceref(2))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhoy
+C        modify by conv. To use : var = Agrif_Parent_Rhoy()
+C                    REAL(Agrif_Curgrid % parent % spaceref(2))
+C     **************************************************************************
+CCC   Function Agrif_Irhoy
+C        modify by conv. To use : var = Agrif_Parent_IRhoy()
+C                    Agrif_Curgrid % spaceref(2)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhoy
+C        modify by conv. To use : var = Agrif_Parent_IRhoy()
+C                    Agrif_Curgrid % parent % spaceref(2)
+C     **************************************************************************
+CCC   Function Agrif_Rhoz
+C        modify by conv. To use : var = Agrif_Rhoz()
+C                    REAL(Agrif_Curgrid % spaceref(3))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhoz
+C        modify by conv. To use : var = Agrif_Parent_Rhoz()
+C                    REAL(Agrif_Curgrid % parent % spaceref(3))
+C     **************************************************************************
+CCC   Function Agrif_Irhoz
+C        modify by conv. To use : var = Agrif_Parent_IRhoz()
+C                    Agrif_Curgrid % spaceref(3)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhoz
+C        modify by conv. To use : var = Agrif_Parent_IRhoz()
+C                    Agrif_Curgrid % parent % spaceref(3)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderX
+C        modify by conv. To use : var = Agrif_NearCommonBorderX()
+C                       AGRIF_CURGRID % NearRootBorder(1)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderY
+C        modify by conv. To use : var = Agrif_NearCommonBorderY()
+C                       AGRIF_CURGRID % NearRootBorder(2)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderZ
+C        modify by conv. To use : var = Agrif_NearCommonBorderZ()
+C                       AGRIF_CURGRID % NearRootBorder(3)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderX
+C        modify by conv. To use : var = Agrif_DistantCommonBorderX()
+C                       AGRIF_CURGRID % DistantRootBorder(1)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderY
+C        modify by conv. To use : var = Agrif_DistantCommonBorderY()
+C                       AGRIF_CURGRID % DistantRootBorder(2)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderZ
+C        modify by conv. To use : var = Agrif_DistantCommonBorderZ()
+C                       AGRIF_CURGRID % DistantRootBorder(3)
+C     **************************************************************************
+CCC   Function Agrif_Nb_Step
+C        modify by conv. To use : var = Agrif_Nb_Step()
+C                          AGRIF_CURGRID % ngridstep
+C     **************************************************************************
+CCC   Function Agrif_Nb_Fine_Grids
+C        modify by conv. To use : var = Agrif_Nb_Fine_Grids()
+C                         Agrif_nbfixedgrids 
+C     **************************************************************************
+CCC   Function Agrif_Ix
+C        modify by conv. To use : var = Agrif_Ix()
+C                         Agrif_CURGRID % ix(1) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Ix
+C        modify by conv. To use : var = Agrif_Parent_Ix()
+C                        Agrif_CURGRID % parent % ix(1) 
+C     **************************************************************************
+CCC   Function Agrif_Iy
+C        modify by conv. To use : var = Agrif_Iy()
+C                        AGRIF_CURGRID % ix(2) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Iy
+C        modify by conv. To use : var = Agrif_Parent_Iy()
+C                       Agrif_CURGRID % parent % ix(2) 
+C     **************************************************************************
+CCC   Function Agrif_Iz
+C        modify by conv. To use : var = Agrif_Iz()
+C                      AGRIF_CURGRID % ix(3) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Iz
+C        modify by conv. To use : var = Agrif_Parent_Iz()
+C                     Agrif_CURGRID % parent % ix(3) 
+C     **************************************************************************
+CCC   Function Agrif_Get_grid_id
+C        modify by conv. To use : var = Agrif_Get_grid_id()
+C                    Agrif_CURGRID % grid_id
+C     **************************************************************************
+CCC   Function Agrif_Get_parent_id
+C        modify by conv. To use : var = Agrif_Get_parent_id()
+C                    Agrif_CURGRID % parent % grid_id
+C     **************************************************************************
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 10250)
+++ 	(revision )
@@ -1,181 +1,0 @@
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_Link
-!>
-!> This module is used to link AGRIF files to the model.
-!
-module Agrif_Link
-!
-    interface
-!
-        subroutine Agrif_clustering_def ( )
-!
-        end subroutine Agrif_clustering_def
-!
-        subroutine Agrif_Set_numberofcells ( Agrif_Gr )
-            use Agrif_Grids, only : Agrif_Grid
-            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
-        end subroutine Agrif_Set_numberofcells
-!
-        subroutine Agrif_Get_numberofcells ( Agrif_Gr )
-            use Agrif_Grids, only : Agrif_Grid
-            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
-        end subroutine Agrif_Get_numberofcells
-!
-    end interface
-!
-    abstract interface
-!
-        subroutine alloc_proc ( Agrif_Gr )
-            use Agrif_Grids, only : Agrif_Grid
-            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
-        end subroutine alloc_proc
-!
-        subroutine typedef_proc ( )
-            implicit none
-        end subroutine typedef_proc
-!
-    end interface
-    
-    procedure(alloc_proc)   :: Agrif_Allocationcalls
-    procedure(typedef_proc) :: Agrif_probdim_modtype_def
-!
-end module Agrif_Link
-!
-!===================================================================================================
-!  function Agrif_parent
-!        modify by conv. To use : un_parent = Agrif_Parent(un)
-!===================================================================================================
-!  function Agrif_Get_Coarse_Grid
-!        modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un)
-!===================================================================================================
-!  function Agrif_Rhox
-!        modify by conv. To use : var = Agrif_Rhox()
-!                    REAL(Agrif_Curgrid % spaceref(1))
-!===================================================================================================
-!  function Agrif_Parent_Rhox
-!        modify by conv. To use : var = Agrif_Parent_Rhox()
-!                    REAL(Agrif_Curgrid % parent % spaceref(1))
-!===================================================================================================
-!  function Agrif_Irhox
-!        modify by conv. To use : var = Agrif_Parent_IRhox()
-!                    Agrif_Curgrid % spaceref(1)
-!===================================================================================================
-!  function Agrif_Parent_Irhox
-!        modify by conv. To use : var = Agrif_Parent_IRhox()
-!                    Agrif_Curgrid % parent % spaceref(1)
-!===================================================================================================
-!  function Agrif_Rhoy
-!        modify by conv. To use : var = Agrif_Rhoy()
-!                    REAL(Agrif_Curgrid % spaceref(2))
-!===================================================================================================
-!  function Agrif_Parent_Rhoy
-!        modify by conv. To use : var = Agrif_Parent_Rhoy()
-!                    REAL(Agrif_Curgrid % parent % spaceref(2))
-!===================================================================================================
-!  function Agrif_Irhoy
-!        modify by conv. To use : var = Agrif_Parent_IRhoy()
-!                    Agrif_Curgrid % spaceref(2)
-!===================================================================================================
-!  function Agrif_Parent_Irhoy
-!        modify by conv. To use : var = Agrif_Parent_IRhoy()
-!                    Agrif_Curgrid % parent % spaceref(2)
-!===================================================================================================
-!  function Agrif_Rhoz
-!        modify by conv. To use : var = Agrif_Rhoz()
-!                    REAL(Agrif_Curgrid % spaceref(3))
-!===================================================================================================
-!  function Agrif_Parent_Rhoz
-!        modify by conv. To use : var = Agrif_Parent_Rhoz()
-!                    REAL(Agrif_Curgrid % parent % spaceref(3))
-!===================================================================================================
-!  function Agrif_Irhoz
-!        modify by conv. To use : var = Agrif_Parent_IRhoz()
-!                    Agrif_Curgrid % spaceref(3)
-!===================================================================================================
-!  function Agrif_Parent_Irhoz
-!        modify by conv. To use : var = Agrif_Parent_IRhoz()
-!                    Agrif_Curgrid % parent % spaceref(3)
-!===================================================================================================
-!  function Agrif_NearCommonBorderX
-!        modify by conv. To use : var = Agrif_NearCommonBorderX()
-!                       Agrif_Curgrid % NearRootBorder(1)
-!===================================================================================================
-!  function Agrif_NearCommonBorderY
-!        modify by conv. To use : var = Agrif_NearCommonBorderY()
-!                       Agrif_Curgrid % NearRootBorder(2)
-!===================================================================================================
-!  function Agrif_NearCommonBorderZ
-!        modify by conv. To use : var = Agrif_NearCommonBorderZ()
-!                       Agrif_Curgrid % NearRootBorder(3)
-!===================================================================================================
-!  function Agrif_DistantCommonBorderX
-!        modify by conv. To use : var = Agrif_DistantCommonBorderX()
-!                       Agrif_Curgrid % DistantRootBorder(1)
-!===================================================================================================
-!  function Agrif_DistantCommonBorderY
-!        modify by conv. To use : var = Agrif_DistantCommonBorderY()
-!                       Agrif_Curgrid % DistantRootBorder(2)
-!===================================================================================================
-!  function Agrif_DistantCommonBorderZ
-!        modify by conv. To use : var = Agrif_DistantCommonBorderZ()
-!                       Agrif_Curgrid % DistantRootBorder(3)
-!===================================================================================================
-!  function Agrif_Nb_Step
-!        modify by conv. To use : var = Agrif_Nb_Step()
-!                          Agrif_Curgrid % ngridstep
-!===================================================================================================
-!  function Agrif_Nb_Fine_Grids
-!        modify by conv. To use : var = Agrif_Nb_Fine_Grids()
-!                         Agrif_nbfixedgrids
-!===================================================================================================
-!  function Agrif_Ix
-!        modify by conv. To use : var = Agrif_Ix()
-!                         Agrif_Curgrid % ix(1)
-!===================================================================================================
-!  function Agrif_Parent_Ix
-!        modify by conv. To use : var = Agrif_Parent_Ix()
-!                        Agrif_Curgrid % parent % ix(1)
-!===================================================================================================
-!  function Agrif_Iy
-!        modify by conv. To use : var = Agrif_Iy()
-!                        Agrif_Curgrid % ix(2)
-!===================================================================================================
-!  function Agrif_Parent_Iy
-!        modify by conv. To use : var = Agrif_Parent_Iy()
-!                       Agrif_Curgrid % parent % ix(2)
-!===================================================================================================
-!  function Agrif_Iz
-!        modify by conv. To use : var = Agrif_Iz()
-!                      Agrif_Curgrid % ix(3)
-!===================================================================================================
-!  function Agrif_Parent_Iz
-!        modify by conv. To use : var = Agrif_Parent_Iz()
-!                     Agrif_Curgrid % parent % ix(3)
-!===================================================================================================
-!  function Agrif_Get_grid_id
-!        modify by conv. To use : var = Agrif_Get_grid_id()
-!                    Agrif_Curgrid % grid_id
-!===================================================================================================
-!  function Agrif_Get_parent_id
-!        modify by conv. To use : var = Agrif_Get_parent_id()
-!                    Agrif_Curgrid % parent % grid_id
-!===================================================================================================
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 10251)
@@ -0,0 +1,688 @@
+!
+! $Id: modmask.F 2528 2010-12-27 17:33:53Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Mask
+C
+      Module Agrif_Mask
+C
+CCC   Description:
+CCC   Module for masks
+C
+C     Modules used: 
+C
+      Use Agrif_Types       
+C
+      IMPLICIT NONE
+C
+      CONTAINS
+C     Define procedures contained in this module
+C
+C     **************************************************************************
+C     Subroutine Agrif_CheckMasknD
+C     **************************************************************************
+C       
+      Subroutine Agrif_CheckMasknD(tempP,parent,pbtab,petab,ppbtab,
+     &               ppetab,noraftab,nbdim)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: pbtab  ! Limits of the parent grid used  
+      INTEGER,DIMENSION(nbdim) :: petab  ! interpolation of the child grid
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+C
+C     Pointer argument
+      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C     Data TYPE argument                                   
+      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
+C
+C     Local scalar
+      INTEGER                   :: i0,j0,k0,l0,m0,n0
+C      
+C     Local arrays
+C
+C      
+      SELECT CASE (nbdim)
+      CASE (1)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array1(i0)
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+      CASE (2)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array2(i0,j0)
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo  
+         enddo
+      CASE (3)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array3(i0,j0,k0)
+     &                        == Agrif_SpecialValue) Then
+!------CDIR NEXPAND
+            Call CalculNewValTempP3D((/i0,j0,k0/),
+     &      tempP%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
+     &      parent%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
+     &                           ppbtab,ppetab,
+     &                           noraftab,MaxSearch,Agrif_SpecialValue)
+     
+c            Call CalculNewValTempP((/i0,j0,k0/),
+c     &                             tempP,parent,
+c     &                             ppbtab,ppetab,
+c     &                             noraftab,nbdim)
+          
+         ENDIF
+         enddo
+         enddo  
+         enddo
+      CASE (4)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array4(i0,j0,k0,l0) 
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP4D((/i0,j0,k0,l0/),
+     &      tempP%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
+     &      parent%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
+     &                           ppbtab,ppetab,
+     &                           noraftab,MaxSearch,Agrif_SpecialValue)
+         ENDIF
+         enddo
+         enddo
+         enddo  
+         enddo
+      CASE (5)
+         do m0 = pbtab(5),petab(5)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array5(i0,j0,k0,l0,m0) 
+     &                       == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0,k0,l0,m0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+         enddo
+         enddo  
+         enddo
+         enddo
+      CASE (6)
+         do n0 = pbtab(6),petab(6)
+         do m0 = pbtab(5),petab(5)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array6(i0,j0,k0,l0,m0,n0) 
+     &                       == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+         enddo
+         enddo
+         enddo  
+         enddo
+         enddo
+      END SELECT
+C
+C      
+C     
+      End Subroutine Agrif_CheckMasknD
+C
+C
+C     **************************************************************************
+C     Subroutine CalculNewValTempP
+C     **************************************************************************
+C       
+      Subroutine CalculNewValTempP(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,nbdim)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+C
+C     Pointer argument
+      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C     Data TYPE argument                                   
+      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      LOGICAL                  :: firsttest
+C      
+C     Local arrays      
+C
+      ValMax = 1
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+!CDIR NOVECTOR
+      imin = indic
+!CDIR NOVECTOR
+      imax = indic
+C
+         i = 1
+         firsttest = .TRUE.
+C
+         do While(i <= ValMax)
+C
+         IF ((i == 1).AND.(firsttest)) i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+                  if (firsttest) then               
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+!CDIR NOVECTOR
+                     idecal = indic
+                     idecal(iii) = idecal(iii)-1
+                     SELECT CASE(nbdim)
+                     CASE (1)
+                        if (tempP%var%array1(idecal(1)
+     &                            ) == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif                     
+                     CASE (2)
+                        if (tempP%var%array2(idecal(1),
+     &            idecal(2)) == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif
+                     CASE (3)
+                        if (tempP%var%array3(idecal(1),
+     &            idecal(2),idecal(3)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif  
+                     CASE (4)
+                        if (tempP%var%array4(idecal(1),
+     &            idecal(2),idecal(3),idecal(4)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif     
+                     CASE (5)
+                        if (tempP%var%array5(idecal(1),
+     &            idecal(2),idecal(3),idecal(4),idecal(5)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif  
+                     CASE (6)
+                        if (tempP%var%array6(idecal(1),
+     &            idecal(2),idecal(3),idecal(4),idecal(5),idecal(6)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif                                                                                           
+                     END SELECT
+                  endif
+                  endif
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+            SELECT CASE(nbdim)
+            CASE (1)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array1(ii)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+               enddo
+C
+            CASE (2)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array2(ii,jj)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+               enddo  
+               enddo
+               
+            CASE (3)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array3(ii,jj,kk)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (4)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array4(ii,jj,kk,ll)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (5)
+               do mm = imin(5),imax(5)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array5(ii,jj,kk,ll,mm)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                                    enddo
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (6)
+               do nn = imin(6),imax(6)
+               do mm = imin(5),imax(5)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array6(ii,jj,kk,ll,mm,nn)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                                          enddo
+                                    enddo
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            END SELECT
+C
+C
+            
+            if (Nbvals.GT.0) then
+              if (firsttest) then
+                   firsttest = .FALSE.
+                   i=1
+                   cycle
+              endif
+            SELECT CASE(nbdim)
+            CASE (1)              
+              tempP%var%array1(indic(1)) 
+     &           = Res/Nbvals
+            CASE (2)
+              tempP%var%array2(indic(1),
+     &                            indic(2)) = Res/Nbvals
+            CASE (3)
+              tempP%var%array3(indic(1),
+     &                            indic(2),indic(3)) = Res/Nbvals
+            CASE (4)
+              tempP%var%array4(indic(1),
+     &                            indic(2),indic(3),indic(4))
+     &                = Res/Nbvals
+            CASE (5)
+              tempP%var%array5(indic(1),
+     &                            indic(2),indic(3),indic(4),
+     &                   indic(5)) = Res/Nbvals
+            CASE (6)
+              tempP%var%array6(indic(1),
+     &                            indic(2),indic(3),indic(4),
+     &                           indic(5),indic(6)) = Res/Nbvals
+            END SELECT
+              exit
+            else
+               if (firsttest) exit
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP
+C
+C
+      End Module Agrif_Mask     
+      
+      Subroutine CalculNewValTempP3D(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER, PARAMETER :: nbdim = 3
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+      REAL :: Agrif_SpecialValue
+C
+C     Pointer argument
+      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
+     &    ppbtab(3):ppetab(3)) :: tempP, parent  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      INTEGER :: MaxSearch
+      LOGICAL :: Existunmasked
+C      
+C     Local arrays      
+C
+      ValMax = 1
+!CDIR NOVECTOR
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+!CDIR NOVECTOR
+      imin = indic
+!CDIR NOVECTOR
+      imax = indic
+      
+!CDIR NOVECTOR
+         idecal = indic	 
+C
+         i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+         
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+                     idecal(iii) = idecal(iii)-1
+
+                        if (tempP(idecal(1),idecal(2),idecal(3)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif
+
+                     idecal(iii) = idecal(iii)+1
+                  endif
+
+               endif            
+            enddo
+C
+            Existunmasked = .FALSE.
+C
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+               do ii = imin(1),imax(1)
+                    if ( parent(ii,jj,kk) .NE. Agrif_SpecialValue) then
+                        Existunmasked = .TRUE.
+                       exit
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+C
+C
+          if (.Not.Existunmasked) return
+C
+         i = 1
+C
+         do While(i <= ValMax)
+C
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+               do ii = imin(1),imax(1)
+                    ValParent = parent(ii,jj,kk)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+C
+C
+            
+            if (Nbvals.GT.0) then
+              tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
+              exit
+            else
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP3D        
+
+      Subroutine CalculNewValTempP4D(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER, PARAMETER :: nbdim = 4
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+      INTEGER :: MaxSearch      
+      REAL :: Agrif_SpecialValue      
+C
+C     Pointer argument
+      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
+     &    ppbtab(3):ppetab(3),
+     &    ppbtab(4):ppetab(4)) :: tempP, parent  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      LOGICAL                  :: firsttest
+C      
+C     Local arrays      
+C
+      ValMax = 1
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+      imin = indic
+      imax = indic
+C
+         i = 1
+         firsttest = .TRUE.
+         idecal = indic	 
+	 
+C
+         do While(i <= ValMax)
+C
+         IF ((i == 1).AND.(firsttest)) i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+                  if (firsttest) then               
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+
+                     idecal(iii) = idecal(iii)-1
+		     
+                     if (tempP(idecal(1),idecal(2),idecal(3),idecal(4))
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                     endif
+		     
+		     idecal(iii) = idecal(iii)+1
+                  endif
+                  endif
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+               do ii = imin(1),imax(1)
+                    ValParent = parent(ii,jj,kk,ll)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+C
+C
+            
+            if (Nbvals.GT.0) then
+              if (firsttest) then
+                   firsttest = .FALSE.
+                   i=1
+                   cycle
+              endif
+	      
+              tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
+	    
+              exit
+            else
+               if (firsttest) exit
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP4D        
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 10250)
+++ 	(revision )
@@ -1,586 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_Mask.
-!>
-!> Module for masks.
-!
-module Agrif_Mask
-!
-    use Agrif_Types
-!
-    implicit none
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_CheckMasknD
-!
-!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
-!! when this one is equal to Agrif_SpecialValue.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
-    type(Agrif_Variable), pointer   :: parent !< The parent grid
-    integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used
-    integer, dimension(nbdim)       :: petab  !< interpolation of the child grid
-    integer, dimension(nbdim)       :: ppbtab, ppetab
-    logical, dimension(nbdim)       :: noraftab
-    integer                         :: nbdim
-!
-    integer :: i0,j0,k0,l0,m0,n0
-!
-    select case (nbdim)
-    case (1)
-        do i0 = pbtab(1),petab(1)
-            if (tempP%array1(i0) == Agrif_SpecialValue) then
-                call CalculNewValTempP((/i0/),tempP,parent,ppbtab,ppetab,noraftab,nbdim)
-            endif
-        enddo
-    case (2)
-        do j0 = pbtab(2),petab(2)
-        do i0 = pbtab(1),petab(1)
-            if (tempP%array2(i0,j0) == Agrif_SpecialValue) then
-                call CalculNewValTempP((/i0,j0/),tempP,parent,ppbtab,ppetab, noraftab,nbdim)
-            endif
-        enddo
-        enddo
-    case (3)
-        do k0 = pbtab(3),petab(3)
-        do j0 = pbtab(2),petab(2)
-        do i0 = pbtab(1),petab(1)
-            if (tempP%array3(i0,j0,k0) == Agrif_SpecialValue) then
-!------CDIR NEXPAND
-                call CalculNewValTempP3D((/i0,j0,k0/), &
-                    tempP%array3(ppbtab(1),ppbtab(2),ppbtab(3)),  &
-                    parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), &
-                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
-
-!            Call CalculNewValTempP((/i0,j0,k0/),
-!     &                             tempP,parent,
-!     &                             ppbtab,ppetab,
-!     &                             noraftab,nbdim)
-
-            endif
-        enddo
-        enddo
-        enddo
-    case (4)
-        do l0 = pbtab(4),petab(4)
-        do k0 = pbtab(3),petab(3)
-        do j0 = pbtab(2),petab(2)
-        do i0 = pbtab(1),petab(1)
-            if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
-                call CalculNewValTempP4D((/i0,j0,k0,l0/), &
-                    tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  &
-                    parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), &
-                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
-    case (5)
-        do m0 = pbtab(5),petab(5)
-        do l0 = pbtab(4),petab(4)
-        do k0 = pbtab(3),petab(3)
-        do j0 = pbtab(2),petab(2)
-        do i0 = pbtab(1),petab(1)
-            if (tempP%array5(i0,j0,k0,l0,m0) == Agrif_SpecialValue) then
-                call CalculNewValTempP((/i0,j0,k0,l0,m0/), &
-                    tempP,parent,ppbtab,ppetab,noraftab,nbdim)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-    case (6)
-        do n0 = pbtab(6),petab(6)
-        do m0 = pbtab(5),petab(5)
-        do l0 = pbtab(4),petab(4)
-        do k0 = pbtab(3),petab(3)
-        do j0 = pbtab(2),petab(2)
-        do i0 = pbtab(1),petab(1)
-            if (tempP%array6(i0,j0,k0,l0,m0,n0) == Agrif_SpecialValue) then
-                call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/), &
-                    tempP,parent,ppbtab,ppetab,noraftab,nbdim)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-        enddo
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_CheckMasknD
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine CalculNewValTempP
-!
-!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
-!! when this one is equal to Agrif_SpecialValue.
-!---------------------------------------------------------------------------------------------------
-subroutine CalculNewValTempP ( indic, tempP, parent, ppbtab, ppetab, noraftab, nbdim )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(nbdim)       :: indic
-    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
-    type(Agrif_Variable), pointer   :: parent !< The parent grid
-    integer, dimension(nbdim)       :: ppbtab, ppetab
-    logical, dimension(nbdim)       :: noraftab
-    integer                         :: nbdim
-!
-    integer                     :: i,ii,iii,jj,kk,ll,mm,nn
-    integer, dimension(nbdim)   :: imin,imax,idecal
-    integer                     :: nbvals
-    real                        :: res
-    real                        :: valparent
-    integer                     :: ValMax
-    logical                     :: firsttest
-!
-    ValMax = 1
-    do iii = 1,nbdim
-        if (.NOT.noraftab(iii)) then
-            ValMax = max(ValMax,ppetab(iii)-indic(iii))
-            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-        endif
-    enddo
-!
-    Valmax = min(Valmax,MaxSearch)
-!
-!CDIR NOVECTOR
-    imin = indic
-!CDIR NOVECTOR
-    imax = indic
-!
-    i = 1
-    firsttest = .TRUE.
-!
-    do while (i <= ValMax)
-!
-        if ( (i == 1).AND.(firsttest) ) i = Valmax
-!
-        do iii = 1,nbdim
-            if (.NOT.noraftab(iii)) then
-                imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                imax(iii) = min(indic(iii) + i,ppetab(iii))
-                if (firsttest) then
-                    if (indic(iii) > ppbtab(iii)) then
-!CDIR NOVECTOR
-                        idecal = indic
-                        idecal(iii) = idecal(iii)-1
-                        SELECT CASE(nbdim)
-                        CASE (1)
-                            if (tempP%array1(idecal(1) &
-                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
-                        CASE (2)
-                            if (tempP%array2(idecal(1), idecal(2) &
-                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
-                        CASE (3)
-                            if (tempP%array3(idecal(1), &
-                                             idecal(2), idecal(3) &
-                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
-                        CASE (4)
-                            if (tempP%array4(idecal(1), idecal(2), &
-                                             idecal(3), idecal(4)  &
-                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
-                        CASE (5)
-                            if (tempP%array5(idecal(1), idecal(2), &
-                                             idecal(3), idecal(4), &
-                                             idecal(5)             &
-                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
-                        CASE (6)
-                            if (tempP%array6(idecal(1), idecal(2), &
-                                             idecal(3), idecal(4), &
-                                             idecal(5), idecal(6)  &
-                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
-                        END SELECT
-                    endif
-                endif
-            endif
-        enddo
-!
-        Res = 0.
-        Nbvals = 0
-!
-        SELECT CASE(nbdim)
-        CASE (1)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-            do ii = imin(1),imax(1)
-                ValParent = parent%array1(ii)
-                if ( ValParent /= Agrif_SpecialValue) then
-                    Res = Res + ValParent
-                    Nbvals = Nbvals + 1
-                endif
-            enddo
-!
-        CASE (2)
-            do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-            do ii = imin(1),imax(1)
-                ValParent = parent%array2(ii,jj)
-                if ( ValParent /= Agrif_SpecialValue) then
-                    Res = Res + ValParent
-                    Nbvals = Nbvals + 1
-                endif
-            enddo
-            enddo
-
-        CASE (3)
-            do kk = imin(3),imax(3)
-            do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-            do ii = imin(1),imax(1)
-                ValParent = parent%array3(ii,jj,kk)
-                if ( ValParent /= Agrif_SpecialValue) then
-                    Res = Res + ValParent
-                    Nbvals = Nbvals + 1
-                endif
-            enddo
-            enddo
-            enddo
-
-        CASE (4)
-            do ll = imin(4),imax(4)
-            do kk = imin(3),imax(3)
-            do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-            do ii = imin(1),imax(1)
-                ValParent = parent%array4(ii,jj,kk,ll)
-                if ( ValParent /= Agrif_SpecialValue) then
-                    Res = Res + ValParent
-                    Nbvals = Nbvals + 1
-                endif
-            enddo
-            enddo
-            enddo
-            enddo
-
-        CASE (5)
-            do mm = imin(5),imax(5)
-            do ll = imin(4),imax(4)
-            do kk = imin(3),imax(3)
-            do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-            do ii = imin(1),imax(1)
-                ValParent = parent%array5(ii,jj,kk,ll,mm)
-                if ( ValParent /= Agrif_SpecialValue) then
-                    Res = Res + ValParent
-                    Nbvals = Nbvals + 1
-                endif
-            enddo
-            enddo
-            enddo
-            enddo
-            enddo
-
-        CASE (6)
-            do nn = imin(6),imax(6)
-            do mm = imin(5),imax(5)
-            do ll = imin(4),imax(4)
-            do kk = imin(3),imax(3)
-            do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-            do ii = imin(1),imax(1)
-                ValParent = parent%array6(ii,jj,kk,ll,mm,nn)
-                if ( ValParent /= Agrif_SpecialValue) then
-                    Res = Res + ValParent
-                    Nbvals = Nbvals + 1
-                endif
-            enddo
-            enddo
-            enddo
-            enddo
-            enddo
-            enddo
-
-        END SELECT
-!
-        if (Nbvals > 0) then
-            if (firsttest) then
-                firsttest = .FALSE.
-                i=1
-                cycle
-            endif
-            SELECT CASE(nbdim)
-            CASE (1)
-                tempP%array1(indic(1))           = Res/Nbvals
-            CASE (2)
-                tempP%array2(indic(1), indic(2)) = Res/Nbvals
-            CASE (3)
-                tempP%array3(indic(1), indic(2), &
-                             indic(3))           = Res/Nbvals
-            CASE (4)
-                tempP%array4(indic(1), indic(2), &
-                             indic(3), indic(4)) = Res/Nbvals
-            CASE (5)
-                tempP%array5(indic(1), indic(2), &
-                             indic(3), indic(4), &
-                             indic(5))           = Res/Nbvals
-            CASE (6)
-                tempP%array6(indic(1), indic(2), &
-                             indic(3), indic(4), &
-                             indic(5), indic(6)) = Res/Nbvals
-            END SELECT
-            exit
-        else
-            if (firsttest) exit
-            i = i + 1
-        endif
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine CalculNewValTempP
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine CalculNewValTempP3D
-!
-!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
-!! when this one is equal to Agrif_SpecialValue.
-!---------------------------------------------------------------------------------------------------
-subroutine CalculNewValTempP3D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
-                                 MaxSearch, Agrif_SpecialValue )
-!---------------------------------------------------------------------------------------------------
-    integer, parameter          :: nbdim = 3
-    integer, dimension(nbdim)   :: indic
-    integer, dimension(nbdim)   :: ppbtab, ppetab
-    logical, dimension(nbdim)   :: noraftab
-    integer                     :: MaxSearch
-    real                        :: Agrif_SpecialValue
-    real, dimension(ppbtab(1):ppetab(1), &
-                    ppbtab(2):ppetab(2), &
-                    ppbtab(3):ppetab(3)) &
-                                :: tempP, parent  !< Part of the parent grid used for
-                                                  !< the interpolation of the child grid
-!
-    integer                     :: i,ii,iii,jj,kk
-    integer, dimension(nbdim)   :: imin,imax,idecal
-    integer                     :: Nbvals
-    real                        :: Res
-    real                        :: ValParent
-    integer                     :: ValMax
-    logical                     :: Existunmasked
-!
-    ValMax = 1
-!CDIR NOVECTOR
-    do iii = 1,nbdim
-        if (.NOT.noraftab(iii)) then
-            ValMax = max(ValMax,ppetab(iii)-indic(iii))
-            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-        endif
-    enddo
-!
-    Valmax = min(Valmax,MaxSearch)
-!
-!CDIR NOVECTOR
-    imin = indic
-!CDIR NOVECTOR
-    imax = indic
-
-!CDIR NOVECTOR
-    idecal = indic
-    i = Valmax
-!
-    do iii = 1,nbdim
-        if (.NOT.noraftab(iii)) then
-            imin(iii) = max(indic(iii) - i,ppbtab(iii))
-            imax(iii) = min(indic(iii) + i,ppetab(iii))
-
-            if (indic(iii) > ppbtab(iii)) then
-                idecal(iii) = idecal(iii)-1
-                if (tempP(idecal(1),idecal(2),idecal(3)) == Agrif_SpecialValue) then
-                    imin(iii) = imax(iii)
-                endif
-                idecal(iii) = idecal(iii)+1
-            endif
-        endif
-    enddo
-!
-    Existunmasked = .FALSE.
-!
-    do kk = imin(3),imax(3)
-    do jj = imin(2),imax(2)
-!CDIR NOVECTOR
-    do ii = imin(1),imax(1)
-        if ( parent(ii,jj,kk) /= Agrif_SpecialValue) then
-            Existunmasked = .TRUE.
-            exit
-        endif
-    enddo
-    enddo
-    enddo
-!
-    if (.Not.Existunmasked) return
-!
-    i = 1
-!
-    do while(i <= ValMax)
-!
-        do iii = 1 , nbdim
-            if (.NOT.noraftab(iii)) then
-                imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                imax(iii) = min(indic(iii) + i,ppetab(iii))
-            endif
-        enddo
-!
-        Res = 0.
-        Nbvals = 0
-!
-        do kk = imin(3),imax(3)
-        do jj = imin(2),imax(2)
-!CDIR NOVECTOR
-        do ii = imin(1),imax(1)
-            ValParent = parent(ii,jj,kk)
-            if ( ValParent /= Agrif_SpecialValue) then
-                Res = Res + ValParent
-                Nbvals = Nbvals + 1
-            endif
-        enddo
-        enddo
-        enddo
-!
-        if (Nbvals > 0) then
-            tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
-            exit
-        else
-            i = i + 1
-        endif
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine CalculNewValTempP3D
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine CalculNewValTempP4D
-!
-!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
-!! when this one is equal to Agrif_SpecialValue.
-!---------------------------------------------------------------------------------------------------
-subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
-                                 MaxSearch, Agrif_SpecialValue )
-!---------------------------------------------------------------------------------------------------
-    integer, parameter          :: nbdim = 4
-    integer, dimension(nbdim)   :: indic
-    integer, dimension(nbdim)   :: ppbtab, ppetab
-    logical, dimension(nbdim)   :: noraftab
-    integer                     :: MaxSearch
-    real                        :: Agrif_SpecialValue
-    real, dimension(ppbtab(1):ppetab(1), &
-                    ppbtab(2):ppetab(2), &
-                    ppbtab(3):ppetab(3), &
-                    ppbtab(4):ppetab(4)) &
-                                :: tempP, parent  !< Part of the parent grid used for
-                                                  !< the interpolation of the child grid
-!
-    integer                     :: i,ii,iii,jj,kk,ll
-    integer, dimension(nbdim)   :: imin,imax,idecal
-    integer                     :: Nbvals
-    real                        :: Res
-    real                        :: ValParent
-    integer                     :: ValMax
-!
-    logical                     :: firsttest
-!
-    ValMax = 1
-    do iii = 1,nbdim
-        if (.NOT.noraftab(iii)) then
-            ValMax = max(ValMax,ppetab(iii)-indic(iii))
-            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-        endif
-    enddo
-!
-    Valmax = min(Valmax,MaxSearch)
-!
-    imin = indic
-    imax = indic
-!
-    i = 1
-    firsttest = .TRUE.
-    idecal = indic
-!
-    do while (i <= ValMax)
-!
-        if ((i == 1).AND.(firsttest)) i = Valmax
-
-        do iii = 1,nbdim
-            if (.NOT.noraftab(iii)) then
-                imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                imax(iii) = min(indic(iii) + i,ppetab(iii))
-                if (firsttest) then
-                    if (indic(iii) > ppbtab(iii)) then
-                        idecal(iii) = idecal(iii)-1
-                        if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then
-                            imin(iii) = imax(iii)
-                        endif
-                        idecal(iii) = idecal(iii)+1
-                    endif
-                endif
-            endif
-        enddo
-!
-        Res = 0.
-        Nbvals = 0
-!
-        do ll = imin(4),imax(4)
-        do kk = imin(3),imax(3)
-        do jj = imin(2),imax(2)
-        do ii = imin(1),imax(1)
-            ValParent = parent(ii,jj,kk,ll)
-            if ( ValParent /= Agrif_SpecialValue) then
-                Res = Res + ValParent
-                Nbvals = Nbvals + 1
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
-!
-        if (Nbvals > 0) then
-            if (firsttest) then
-                firsttest = .FALSE.
-                i=1
-                cycle
-            endif
-
-            tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
-            exit
-        else
-            if (firsttest) exit
-            i = i + 1
-        endif
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine CalculNewValTempP4D
-!===================================================================================================
-!
-end module Agrif_Mask
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 10251)
@@ -0,0 +1,1119 @@
+!
+! $Id: modmpp.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_mpp
+C
+      Module Agrif_mpp
+      Use Agrif_Types
+      Use Agrif_Arrays
+
+      Contains
+#ifdef key_mpp_mpi
+      Subroutine Get_External_Data_first(pttruetab,
+     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
+     &   memberout,memberoutall1,sendtoproc,recvfromproc,imin,imax,
+     &   imin_recv,imax_recv)
+
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
+     &                                                 cetruetab
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
+     &                                                 cetruetabwhole
+      INTEGER :: k,i,k2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc, recvfromproc
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1):: imin,imax,
+     &   imin_recv,imax_recv
+      LOGICAL :: memberin, memberout
+      INTEGER :: imintmp, imaxtmp,j,i1
+      INTEGER :: imin1,imax1
+      LOGICAL :: tochange,tochangebis
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
+     &                                                 cetruetab2
+      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
+      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
+      INTEGER :: code
+      
+C pttruetab2 and cetruetab2 are modified arraysin order to always
+C send the most inner points
+
+        
+        IF (present(memberoutall1)) THEN
+        memberoutall = memberoutall1
+        ELSE
+         memberout1(1) = memberout
+
+         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+        ENDIF
+         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+         do k2=0,Agrif_Nbprocs-1
+            do i=1,nbdim
+
+           tochangebis=.TRUE.
+           DO i1=1,nbdim
+            IF (i .NE. i1) THEN
+              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
+     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
+                   tochangebis = .FALSE.
+               EXIT
+              ENDIF
+             ENDIF
+           ENDDO
+
+           IF (tochangebis) THEN
+
+
+          imin1 = max(pttruetab(i,Agrif_Procrank),
+     &                    pttruetab(i,k2))
+          imax1 = min(cetruetab(i,Agrif_Procrank),
+     &                    cetruetab(i,k2))
+
+C Always send the most interior points
+
+           tochange = .false.
+           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
+
+           DO j=imin1,imax1
+             IF ((cetruetab(i,k2)-j) >
+     &             (j-pttruetab(i,Agrif_Procrank))) THEN
+             imintmp = j+1
+             tochange = .TRUE.
+             ELSE
+              EXIT
+             ENDIF
+          ENDDO
+          ENDIF
+
+           if (tochange) then
+C
+              pttruetab2(i,Agrif_Procrank) = imintmp
+C
+          endif
+
+           tochange = .FALSE.
+           imaxtmp=0
+           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
+          DO j=imax1,imin1,-1
+            IF ((j-pttruetab(i,k2)) >
+     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
+             imaxtmp = j-1
+             tochange = .TRUE.
+            ELSE
+             EXIT
+            ENDIF
+          ENDDO
+
+          ENDIF
+
+                    if (tochange) then
+C
+              cetruetab2(i,Agrif_Procrank) = imaxtmp
+C
+          endif
+C
+
+          ENDIF
+           enddo
+         enddo
+
+
+       do k = 0,Agrif_NbProcs-1
+C
+        sendtoproc(k) = .true.
+C
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+C
+          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
+     &                    pttruetabwhole(i,k))
+          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
+     &                    cetruetabwhole(i,k))
+C
+          if (imin(i,k) > imax(i,k)) then
+C
+              sendtoproc(k) = .false.
+C
+          endif
+C
+        enddo
+        IF (.NOT.memberoutall(k)) THEN
+           sendtoproc(k) = .FALSE.
+        ENDIF
+C
+      enddo
+      
+      Call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,
+     &     recvfromproc,imin_recv,imax_recv)
+      
+      End Subroutine Get_External_Data_first
+C
+      Subroutine Get_External_Data(tempC,tempCextend,pttruetab,
+     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
+     &   memberout,memberoutall1)
+
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER :: nbdim
+      TYPE(Agrif_PVariable) :: tempC, tempCextend
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
+     &                                                 cetruetab
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
+     &                                                 cetruetabwhole
+      INTEGER :: k,i,k2
+      LOGICAL :: sendtoproc(0:Agrif_Nbprocs-1)
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: imin,imax
+      LOGICAL :: memberin, memberout
+      INTEGER :: imintmp, imaxtmp,j,i1
+      INTEGER :: imin1,imax1
+      LOGICAL :: tochange,tochangebis
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
+     &                                                 cetruetab2
+      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
+      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
+      INTEGER :: code
+
+C pttruetab2 and cetruetab2 are modified arraysin order to always
+C send the most inner points
+
+        
+        IF (present(memberoutall1)) THEN
+        memberoutall = memberoutall1
+        ELSE
+         memberout1(1) = memberout
+
+         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+        ENDIF
+         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+         do k2=0,Agrif_Nbprocs-1
+            do i=1,nbdim
+
+           tochangebis=.TRUE.
+           DO i1=1,nbdim
+            IF (i .NE. i1) THEN
+              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
+     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
+                   tochangebis = .FALSE.
+               EXIT
+              ENDIF
+             ENDIF
+           ENDDO
+
+           IF (tochangebis) THEN
+
+
+          imin1 = max(pttruetab(i,Agrif_Procrank),
+     &                    pttruetab(i,k2))
+          imax1 = min(cetruetab(i,Agrif_Procrank),
+     &                    cetruetab(i,k2))
+
+C Always send the most interior points
+
+           tochange = .false.
+           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
+
+           DO j=imin1,imax1
+             IF ((cetruetab(i,k2)-j) >
+     &             (j-pttruetab(i,Agrif_Procrank))) THEN
+             imintmp = j+1
+             tochange = .TRUE.
+             ELSE
+              EXIT
+             ENDIF
+          ENDDO
+          ENDIF
+
+           if (tochange) then
+C
+              pttruetab2(i,Agrif_Procrank) = imintmp
+C
+          endif
+
+           tochange = .FALSE.
+           imaxtmp=0
+           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
+          DO j=imax1,imin1,-1
+            IF ((j-pttruetab(i,k2)) >
+     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
+             imaxtmp = j-1
+             tochange = .TRUE.
+            ELSE
+             EXIT
+            ENDIF
+          ENDDO
+
+          ENDIF
+
+                    if (tochange) then
+C
+              cetruetab2(i,Agrif_Procrank) = imaxtmp
+C
+          endif
+C
+
+          ENDIF
+           enddo
+         enddo
+
+
+       do k = 0,Agrif_NbProcs-1
+C
+        sendtoproc(k) = .true.
+C
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+C
+          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
+     &                    pttruetabwhole(i,k))
+          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
+     &                    cetruetabwhole(i,k))
+C
+          if (imin(i,k) > imax(i,k)) then
+C
+              sendtoproc(k) = .false.
+C
+          endif
+C
+        enddo
+        IF (.NOT.memberoutall(k)) THEN
+           sendtoproc(k) = .FALSE.
+        ENDIF
+C
+      enddo
+
+
+c       IF (.NOT.memberin) sendtoproc = .FALSE.
+
+      IF (memberout) THEN
+      Call Agrif_nbdim_allocation(tempCextend%var,
+     &                 pttruetabwhole(:,Agrif_ProcRank),
+     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
+      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
+      ENDIF
+
+      IF (sendtoproc(Agrif_ProcRank)) THEN
+           Call Agrif_nbdim_VarEQvar(tempCextend%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               tempC%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               nbdim)
+      ENDIF
+
+      Call Exchangesamelevel(sendtoproc,nbdim,imin,imax,tempC,
+     &     tempCextend)
+
+      End Subroutine Get_External_Data
+
+       Subroutine ExchangeSameLevel(sendtoproc,nbdim,imin,imax,
+     &          tempC,tempCextend)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+
+      do k = 0,Agrif_ProcRank-1
+C
+C
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
+C
+                enddo
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                
+                  Call Agrif_Send_3Darray(tempC%var%array3,
+     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
+                CASE(4)
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+                enddo
+
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
+     &   imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+       END SELECT
+                        
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                datasize=SIZE(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)))
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)
+                datasize=SIZE(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)))
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                datasize=SIZE(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)))
+                   Call MPI_SEND(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(4)
+                datasize=SIZE(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)))
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                datasize=SIZE(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)))
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                datasize=SIZE(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)))
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+C                imin_recv(:,k) = iminmax_temp(:,1,k)
+C                imax_recv(:,k) = iminmax_temp(:,2,k)
+
+C                datasize = 1
+C
+C                do i = 1,nbdim
+C
+C                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+C                enddo
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,
+     &   iminmax_temp(:,1,k),iminmax_temp(:,2,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              datasize=SIZE(temprecv%var%array1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)
+              datasize=SIZE(temprecv%var%array2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)
+              datasize=SIZE(temprecv%var%array3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              datasize=SIZE(temprecv%var%array4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              datasize=SIZE(temprecv%var%array5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              datasize=SIZE(temprecv%var%array6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+          END SELECT
+            
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,iminmax_temp(:,1,k),iminmax_temp(:,2,k)
+     &            ,0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+            endif
+
+C
+      enddo
+
+          End Subroutine ExchangeSamelevel
+          
+       Subroutine ExchangeSameLevel_first(sendtoproc,nbdim,imin,imax,
+     &          recvfromproc,imin_recv,imax_recv)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+     
+      do k = 0,Agrif_ProcRank-1
+C
+C
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+            endif
+
+C
+      enddo
+
+          End Subroutine ExchangeSamelevel_first          
+
+       Subroutine ExchangeSameLevel2(sendtoproc,recvfromproc,
+     &   nbdim,
+     &          pttruetabwhole,cetruetabwhole,imin,imax,
+     &          imin_recv,imax_recv,memberout,tempC,tempCextend)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: pttruetabwhole,
+     &     cetruetabwhole
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+      LOGICAL :: memberout
+      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+      IF (memberout) THEN
+      Call Agrif_nbdim_allocation(tempCextend%var,
+     &                 pttruetabwhole(:,Agrif_ProcRank),
+     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
+      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
+      ENDIF
+
+      IF (sendtoproc(Agrif_ProcRank)) THEN
+           Call Agrif_nbdim_VarEQvar(tempCextend%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               tempC%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               nbdim)
+      ENDIF
+
+      do k = 0,Agrif_ProcRank-1
+C
+C
+C
+            if (sendtoproc(k)) then
+C
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
+C
+                enddo
+C
+
+                SELECT CASE(nbdim)
+                CASE(1)
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)               
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+     
+                  Call Agrif_Send_3Darray(tempC%var%array3,
+     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
+                CASE(4)
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+
+C
+            if (recvfromproc(k)) then
+
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+                enddo
+
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
+     &   imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)           
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)       
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+       END SELECT
+                        
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            if (sendtoproc(k)) then
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                datasize=SIZE(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)))
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)                
+                datasize=SIZE(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)))
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                datasize=SIZE(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)))
+                   Call MPI_SEND(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(4)
+                datasize=SIZE(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)))
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                datasize=SIZE(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)))
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                datasize=SIZE(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)))
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+
+C
+            if (recvfromproc(k)) then
+C
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,
+     &   imin_recv(:,k),imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              datasize=SIZE(temprecv%var%array1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)           
+              datasize=SIZE(temprecv%var%array2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)           
+              datasize=SIZE(temprecv%var%array3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              datasize=SIZE(temprecv%var%array4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              datasize=SIZE(temprecv%var%array5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              datasize=SIZE(temprecv%var%array6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+          END SELECT
+            
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k)
+     &            ,0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+            endif
+
+C
+      enddo
+                  
+          End Subroutine ExchangeSamelevel2
+          
+          Subroutine Agrif_Send_3Darray(tab3D,bounds,imin,imax,k)
+          integer, dimension(3) :: bounds, imin, imax
+          real,dimension(bounds(1):,bounds(2):,bounds(3):),target
+     &                             :: tab3D
+          integer :: k
+          integer :: etiquette = 100
+          integer :: datasize, code
+        INCLUDE 'mpif.h'
+
+          datasize = SIZE(tab3D(
+     &                       imin(1):imax(1),
+     &                        imin(2):imax(2),
+     &                        imin(3):imax(3)))
+       
+                   Call MPI_SEND(tab3D(
+     &                        imin(1):imax(1),
+     &                        imin(2):imax(2),
+     &                        imin(3):imax(3)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+     
+         End Subroutine Agrif_Send_3Darray
+
+#else
+      Subroutine Agrif_mpp_empty()
+      End Subroutine Agrif_mpp_empty
+#endif
+
+      End Module Agrif_mpp
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 10250)
+++ 	(revision )
@@ -1,634 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-module Agrif_Mpp
-!
-    use Agrif_Arrays
-    use Agrif_Grids
-!
-    implicit none
-!
-    interface
-        subroutine Agrif_get_proc_info ( imin, imax, jmin, jmax )
-            integer, intent(out) :: imin, imax
-            integer, intent(out) :: jmin, jmax
-        end subroutine Agrif_get_proc_info
-    end interface
-!
-    integer, private :: Agrif_MPI_prec
-!
-    private :: Agrif_get_proc_info
-!
-contains
-!
-#if defined AGRIF_MPI
-!===================================================================================================
-!  subroutine Agrif_MPI_Init
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_MPI_Init ( comm )
-!---------------------------------------------------------------------------------------------------
-    integer, optional, intent(in) :: comm    !< MPI communicator to be attached to the root grid.
-!
-    include 'mpif.h'
-    integer :: code, ierr
-    logical :: mpi_was_called
-    integer :: current_mpi_prec
-!
-    call MPI_INITIALIZED( mpi_was_called, code )
-    if( code /= MPI_SUCCESS ) then
-        write(*,*) ': Error in routine mpi_initialized'
-        call MPI_ABORT( MPI_COMM_WORLD, code, ierr )
-    endif
-    if( .not. mpi_was_called ) then
-        write(*,*) '### AGRIF Error : you should call Agrif_MPI_Init *after* MPI_Init.'
-        stop
-    endif
-
-    current_mpi_prec = KIND(1.0)
-    if (current_mpi_prec == 4) then
-      Agrif_MPI_prec = MPI_REAL4
-    else
-      Agrif_MPI_prec = MPI_REAL8
-    endif
-!
-    if ( present(comm) ) then
-        call Agrif_MPI_switch_comm(comm)
-    else
-        call Agrif_MPI_switch_comm(MPI_COMM_WORLD)
-    endif
-!
-    Agrif_Mygrid % communicator = Agrif_mpi_comm
-!
-    if ( Agrif_Parallel_sisters ) then
-        call Agrif_Init_ProcList( Agrif_Mygrid % proc_def_list, Agrif_Nbprocs )
-        call Agrif_pl_copy( Agrif_Mygrid % proc_def_list, Agrif_Mygrid % required_proc_list )
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_MPI_Init
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_MPI_switch_comm ( comm )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: comm    !< MPI communicator you want to switch to.
-!
-    include 'mpif.h'
-    integer :: code
-    logical :: mpi_was_called
-!
-    call MPI_INITIALIZED( mpi_was_called, code )
-    if ( .not. mpi_was_called ) return
-!
-    call MPI_COMM_SIZE(comm, Agrif_Nbprocs, code)
-    call MPI_COMM_RANK(comm, Agrif_ProcRank, code)
-    Agrif_mpi_comm = comm
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_MPI_switch_comm
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_MPI_get_grid_comm ( ) result ( comm )
-!---------------------------------------------------------------------------------------------------
-    integer :: comm
-    comm = Agrif_Curgrid % communicator
-!---------------------------------------------------------------------------------------------------
-end function Agrif_MPI_get_grid_comm
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_MPI_set_grid_comm ( comm )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: comm
-    Agrif_Curgrid % communicator = comm
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_MPI_set_grid_comm
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_Init_ProcList ( proclist, nbprocs )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List), intent(inout) :: proclist
-    integer,               intent(in)    :: nbprocs
-!
-    include 'mpif.h'
-    type(Agrif_Proc), pointer     :: new_proc
-    integer                       :: p, ierr
-    integer                       :: imin, imax, jmin, jmax
-    integer, dimension(5)         :: local_proc_grid_info
-    integer, dimension(5,nbprocs) :: all_procs_grid_info
-!
-    call Agrif_get_proc_info(imin, imax, jmin, jmax)
-!
-    local_proc_grid_info(:) = (/Agrif_Procrank, imin, jmin, imax, jmax/)
-!
-    call MPI_ALLGATHER(local_proc_grid_info, 5, MPI_INTEGER, &
-                       all_procs_grid_info,  5, MPI_INTEGER, Agrif_mpi_comm, ierr)
-!
-    do p = 1,nbprocs
-!
-        allocate(new_proc)
-        new_proc % pn = all_procs_grid_info(1,p)
-        new_proc % imin(1) = all_procs_grid_info(2,p)
-        new_proc % imin(2) = all_procs_grid_info(3,p)
-        new_proc % imax(1) = all_procs_grid_info(4,p)
-        new_proc % imax(2) = all_procs_grid_info(5,p)
-        call Agrif_pl_append( proclist, new_proc )
-!
-    enddo
-!
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Init_ProcList
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Get_External_Data_first
-!---------------------------------------------------------------------------------------------------
-subroutine Get_External_Data_first ( pttruetab, cetruetab, pttruetabwhole, cetruetabwhole,  &
-                                     nbdim, memberoutall, coords, sendtoproc, recvfromproc, &
-                                     imin, imax, imin_recv, imax_recv )
-!---------------------------------------------------------------------------------------------------
-    include 'mpif.h'
-!
-    integer,                                     intent(in)  :: nbdim
-    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in)  :: pttruetab,     cetruetab
-    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in)  :: pttruetabwhole,cetruetabwhole
-    logical, dimension(0:Agrif_Nbprocs-1),       intent(in)  :: memberoutall
-    integer, dimension(nbdim),                   intent(in)  :: coords
-    logical, dimension(0:Agrif_Nbprocs-1),       intent(out) :: sendtoproc
-    logical, dimension(0:Agrif_Nbprocs-1),       intent(out) :: recvfromproc
-    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin,imax
-    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin_recv,imax_recv
-!
-    integer :: imintmp, imaxtmp, i, j, k, i1
-    integer :: imin1,imax1
-    logical :: tochange,tochangebis
-    integer, dimension(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,cetruetab2
-!
-! pttruetab2 and cetruetab2 are modified arrays in order to always
-! send the most inner points
-!
-    pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
-    cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
-!
-    do k = 0,Agrif_Nbprocs-1
-    do i = 1,nbdim
-        tochangebis = .TRUE.
-        DO i1 = 1,nbdim
-            IF (i /= i1) THEN
-                IF ( (pttruetab(i1,Agrif_Procrank) /= pttruetab(i1,k))  .OR. &
-                     (cetruetab(i1,Agrif_Procrank) /= cetruetab(i1,k))) THEN
-                    tochangebis = .FALSE.
-                    EXIT
-                ENDIF
-            ENDIF
-        ENDDO
-        IF (tochangebis) THEN
-            imin1 = max(pttruetab(i,Agrif_Procrank), pttruetab(i,k))
-            imax1 = min(cetruetab(i,Agrif_Procrank), cetruetab(i,k))
-! Always send the most interior points
-
-            tochange = .false.
-            IF (cetruetab(i,Agrif_Procrank) > cetruetab(i,k)) THEN
-                DO j=imin1,imax1
-                    IF ((cetruetab(i,k)-j) > (j-pttruetab(i,Agrif_Procrank))) THEN
-                        imintmp = j+1
-                        tochange = .TRUE.
-                    ELSE
-                        EXIT
-                    ENDIF
-                ENDDO
-            ENDIF
-
-            if (tochange) then
-                pttruetab2(i,Agrif_Procrank) = imintmp
-            endif
-
-            tochange = .FALSE.
-            imaxtmp=0
-            IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k)) THEN
-                DO j=imax1,imin1,-1
-                    IF ((j-pttruetab(i,k)) > (cetruetab(i,Agrif_Procrank)-j)) THEN
-                        imaxtmp = j-1
-                        tochange = .TRUE.
-                    ELSE
-                        EXIT
-                    ENDIF
-                ENDDO
-            ENDIF
-
-            if (tochange) then
-                cetruetab2(i,Agrif_Procrank) = imaxtmp
-            endif
-        ENDIF
-    enddo
-    enddo
-
-    do k = 0,Agrif_NbProcs-1
-!
-        sendtoproc(k) = .true.
-!
-!CDIR SHORTLOOP
-        do i = 1,nbdim
-            imin(i,k) = max(pttruetab2(i,Agrif_Procrank), pttruetabwhole(i,k))
-            imax(i,k) = min(cetruetab2(i,Agrif_Procrank), cetruetabwhole(i,k))
-!
-            if ( (imin(i,k) > imax(i,k)) .and. (coords(i) /= 0) ) then
-                sendtoproc(k) = .false.
-            endif
-        enddo
-        IF ( .not. memberoutall(k) ) THEN
-            sendtoproc(k) = .false.
-        ENDIF
-    enddo
-!
-    call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,recvfromproc,imin_recv,imax_recv)
-!---------------------------------------------------------------------------------------------------
-end subroutine Get_External_Data_first
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine ExchangeSameLevel_first
-!---------------------------------------------------------------------------------------------------
-subroutine ExchangeSameLevel_first ( sendtoproc, nbdim, imin, imax, recvfromproc, &
-                                     imin_recv, imax_recv )
-!---------------------------------------------------------------------------------------------------
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)  :: sendtoproc
-    INTEGER,                                     intent(in)  :: nbdim
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)  :: imin
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)  :: imax
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(out) :: recvfromproc
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imin_recv
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imax_recv
-!
-    include 'mpif.h'
-    INTEGER :: k
-    INTEGER :: etiquette = 100
-    INTEGER :: code
-    LOGICAL :: res
-    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: statut
-    INTEGER, DIMENSION(nbdim,2,0:Agrif_Nbprocs-1)    :: iminmax_temp
-
-    do k = 0,Agrif_ProcRank-1
-!
-        call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code)
-!
-        if (sendtoproc(k)) then
-            iminmax_temp(:,1,k) = imin(:,k)
-            iminmax_temp(:,2,k) = imax(:,k)
-            call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette,Agrif_mpi_comm,code)
-        endif
-!
-    enddo
-!
-!   Reception from others processors of the necessary part of the parent grid
-    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-!
-        call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code)
-        recvfromproc(k) = res
-!
-        if (recvfromproc(k)) then
-            call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
-                    Agrif_mpi_comm,statut,code)
-            imin_recv(:,k) = iminmax_temp(:,1,k)
-            imax_recv(:,k) = iminmax_temp(:,2,k)
-        endif
-!
-    enddo
-
-!   Reception from others processors of the necessary part of the parent grid
-    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-!
-        call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code)
-!
-        if (sendtoproc(k)) then
-!
-            iminmax_temp(:,1,k) = imin(:,k)
-            iminmax_temp(:,2,k) = imax(:,k)
-
-            call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
-                    Agrif_mpi_comm,code)
-        endif
-!
-    enddo
-!
-!
-!   Reception from others processors of the necessary part of the parent grid
-    do k = Agrif_ProcRank-1,0,-1
-!
-        call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code)
-        recvfromproc(k) = res
-!
-        if (recvfromproc(k)) then
-!
-            call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
-                    Agrif_mpi_comm,statut,code)
-
-            imin_recv(:,k) = iminmax_temp(:,1,k)
-            imax_recv(:,k) = iminmax_temp(:,2,k)
-        endif
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine ExchangeSamelevel_first
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine ExchangeSameLevel
-!---------------------------------------------------------------------------------------------------
-subroutine ExchangeSameLevel ( sendtoproc, recvfromproc, nbdim,    &
-                               pttruetabwhole, cetruetabwhole,     &
-                               imin, imax, imin_recv, imax_recv,   &
-                               memberout, tempC, tempCextend )
-!---------------------------------------------------------------------------------------------------
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)    :: sendtoproc
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)    :: recvfromproc
-    INTEGER,                                     intent(in)    :: nbdim
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: pttruetabwhole
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: cetruetabwhole
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: imin,      imax
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: imin_recv, imax_recv
-    LOGICAL,                                     intent(in)    :: memberout
-    TYPE(Agrif_Variable), pointer,               intent(inout) :: tempC, tempCextend
-!
-    include 'mpif.h'
-    INTEGER :: i,k
-    INTEGER :: etiquette = 100
-    INTEGER :: code, datasize
-    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: statut
-    TYPE(Agrif_Variable), pointer, SAVE   :: temprecv
-!
-    IF (memberout) THEN
-        call Agrif_array_allocate(tempCextend, pttruetabwhole(:,Agrif_ProcRank),  &
-                                               cetruetabwhole(:,Agrif_ProcRank),nbdim)
-        call Agrif_var_set_array_tozero(tempCextend,nbdim)
-    ENDIF
-!
-    IF (sendtoproc(Agrif_ProcRank)) THEN
-        call Agrif_var_copy_array(tempCextend,imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &
-                                  tempC,      imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &
-                                  nbdim)
-    ENDIF
-!
-    do k = 0,Agrif_ProcRank-1
-!
-        if (sendtoproc(k)) then
-!
-            datasize = 1
-!
-!CDIR SHORTLOOP
-            do i = 1,nbdim
-                datasize = datasize * (imax(i,k)-imin(i,k)+1)
-            enddo
-!
-            SELECT CASE(nbdim)
-            CASE(1)
-                call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(2)
-                call MPI_SEND(tempC%array2(imin(1,k):imax(1,k),     &
-                                           imin(2,k):imax(2,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(3)
-                call Agrif_Send_3Darray(tempC%array3,lbound(tempC%array3),imin(:,k),imax(:,k),k)
-            CASE(4)
-                call MPI_SEND(tempC%array4(imin(1,k):imax(1,k),     &
-                                           imin(2,k):imax(2,k),     &
-                                           imin(3,k):imax(3,k),     &
-                                           imin(4,k):imax(4,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(5)
-                call MPI_SEND(tempC%array5(imin(1,k):imax(1,k),     &
-                                           imin(2,k):imax(2,k),     &
-                                           imin(3,k):imax(3,k),     &
-                                           imin(4,k):imax(4,k),     &
-                                           imin(5,k):imax(5,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(6)
-                call MPI_SEND(tempC%array6(imin(1,k):imax(1,k),     &
-                                           imin(2,k):imax(2,k),     &
-                                           imin(3,k):imax(3,k),     &
-                                           imin(4,k):imax(4,k),     &
-                                           imin(5,k):imax(5,k),     &
-                                           imin(6,k):imax(6,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            END SELECT
-!
-        endif
-    enddo
-!
-!   Reception from others processors of the necessary part of the parent grid
-    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-!
-        if (recvfromproc(k)) then
-!
-            datasize = 1
-!
-!CDIR SHORTLOOP
-            do i = 1,nbdim
-                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
-            enddo
-
-            if (.not.associated(temprecv)) allocate(temprecv)
-            call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim)
-
-            SELECT CASE(nbdim)
-            CASE(1)
-                call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette, &
-                        Agrif_mpi_comm,statut,code)
-            CASE(2)
-                call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette, &
-                        Agrif_mpi_comm,statut,code)
-            CASE(3)
-                call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette, &
-                        Agrif_mpi_comm,statut,code)
-            CASE(4)
-                call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette, &
-                        Agrif_mpi_comm,statut,code)
-            CASE(5)
-                call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette, &
-                        Agrif_mpi_comm,statut,code)
-            CASE(6)
-                call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette, &
-                        Agrif_mpi_comm,statut,code)
-            END SELECT
-
-            call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
-            call Agrif_array_deallocate(temprecv,nbdim)
-!
-        endif
-    enddo
-
-!   Reception from others processors of the necessary part of the parent grid
-    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-!
-        if (sendtoproc(k)) then
-!
-            SELECT CASE(nbdim)
-            CASE(1)
-                datasize=SIZE(tempC%array1(imin(1,k):imax(1,k)))
-                call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(2)
-                datasize=SIZE(tempC%array2(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k)))
-                call MPI_SEND(tempC%array2(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(3)
-                datasize=SIZE(tempC%array3(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k),     &
-                                               imin(3,k):imax(3,k)))
-                call MPI_SEND(tempC%array3(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k),     &
-                                               imin(3,k):imax(3,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(4)
-                datasize=SIZE(tempC%array4(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k),     &
-                                               imin(3,k):imax(3,k),     &
-                                               imin(4,k):imax(4,k)))
-                call MPI_SEND(tempC%array4(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k),     &
-                                               imin(3,k):imax(3,k),     &
-                                               imin(4,k):imax(4,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(5)
-                datasize=SIZE(tempC%array5(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k),     &
-                                               imin(3,k):imax(3,k),     &
-                                               imin(4,k):imax(4,k),     &
-                                               imin(5,k):imax(5,k)))
-                call MPI_SEND(tempC%array5(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k),     &
-                                               imin(3,k):imax(3,k),     &
-                                               imin(4,k):imax(4,k),     &
-                                               imin(5,k):imax(5,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            CASE(6)
-                datasize=SIZE(tempC%array6(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k),     &
-                                               imin(3,k):imax(3,k),     &
-                                               imin(4,k):imax(4,k),     &
-                                               imin(5,k):imax(5,k),     &
-                                               imin(6,k):imax(6,k)))
-                call MPI_SEND(tempC%array6(imin(1,k):imax(1,k),     &
-                                               imin(2,k):imax(2,k),     &
-                                               imin(3,k):imax(3,k),     &
-                                               imin(4,k):imax(4,k),     &
-                                               imin(5,k):imax(5,k),     &
-                                               imin(6,k):imax(6,k)),    &
-                        datasize,Agrif_MPI_prec,k,etiquette,      &
-                        Agrif_mpi_comm,code)
-            END SELECT
-!
-        endif
-!
-    enddo
-!
-!   Reception from others processors of the necessary part of the parent grid
-    do k = Agrif_ProcRank-1,0,-1
-!
-        if (recvfromproc(k)) then
-!
-            if (.not.associated(temprecv)) allocate(temprecv)
-            call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim)
-
-            SELECT CASE(nbdim)
-            CASE(1)
-                datasize=SIZE(temprecv%array1)
-                call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette,&
-                        Agrif_mpi_comm,statut,code)
-            CASE(2)
-                datasize=SIZE(temprecv%array2)
-                call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette,&
-                        Agrif_mpi_comm,statut,code)
-            CASE(3)
-                datasize=SIZE(temprecv%array3)
-                call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette,&
-                        Agrif_mpi_comm,statut,code)
-            CASE(4)
-                datasize=SIZE(temprecv%array4)
-                call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette,&
-                          Agrif_mpi_comm,statut,code)
-            CASE(5)
-                datasize=SIZE(temprecv%array5)
-                call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette,&
-                         Agrif_mpi_comm,statut,code)
-            CASE(6)
-                datasize=SIZE(temprecv%array6)
-                call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette,&
-                        Agrif_mpi_comm,statut,code)
-            END SELECT
-
-            call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
-            call Agrif_array_deallocate(temprecv,nbdim)
-!
-        endif
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine ExchangeSamelevel
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Send_3Darray
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Send_3Darray ( tab3D, bounds, imin, imax, k )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(3),                                     intent(in) :: bounds
-    real, dimension(bounds(1):,bounds(2):,bounds(3):), target, intent(in) :: tab3D
-    integer, dimension(3),                                     intent(in) :: imin, imax
-    integer,                                                   intent(in) :: k
-!
-    integer :: etiquette = 100
-    integer :: datasize, code
-    include 'mpif.h'
-
-    datasize = SIZE(tab3D(imin(1):imax(1),  &
-                          imin(2):imax(2),  &
-                          imin(3):imax(3)))
-
-    call MPI_SEND( tab3D( imin(1):imax(1),  &
-                          imin(2):imax(2),  &
-                          imin(3):imax(3)), &
-                          datasize,Agrif_MPI_prec,k,etiquette,Agrif_mpi_comm,code)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Send_3Darray
-!===================================================================================================
-!
-#else
-    subroutine dummy_Agrif_Mpp ()
-    end subroutine dummy_Agrif_Mpp
-#endif
-!
-end Module Agrif_Mpp
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 10250)
+++ 	(revision )
@@ -1,208 +1,0 @@
-module Agrif_Procs
-!
-    implicit none
-!
-    type Agrif_Proc
-        integer               :: pn       !< Proc index in coarse grid
-        integer               :: pi       !< Proc index in x-direction (informative only, could be removed)
-        integer               :: pj       !< Proc index in y-direction (informative only, could be removed)
-        integer, dimension(3) :: imin
-        integer, dimension(3) :: imax
-        integer               :: nb_seqs = 0  !< Number of integration sequences the proc is attached to.
-        integer               :: grid_id = 0  !< Grid id the proc is attached to.
-    end type Agrif_Proc
-!
-    type Agrif_Proc_p
-        type(Agrif_Proc),   pointer   :: proc => NULL()  !< Pointer to the actual proc structure
-        type(Agrif_Proc_p), pointer   :: next => NULL()  !< Next proc in the list
-    end type Agrif_Proc_p
-!
-    type Agrif_Proc_List
-        integer                       :: nitems = 0      !< Number of elements in the list
-        type(Agrif_Proc_p), pointer   :: first => NULL() !< First proc in the list
-        type(Agrif_Proc_p), pointer   :: last  => NULL() !< Last proc inserted in the list
-    end type Agrif_Proc_List
-!
-contains
-!
-!===================================================================================================
-subroutine Agrif_pl_append ( proclist, proc )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List),     intent(inout)  :: proclist
-    type(Agrif_Proc), pointer, intent(in)     :: proc
-!
-    type(Agrif_Proc_p), pointer   :: new_pp
-!
-    allocate( new_pp )
-!
-    new_pp % proc => proc
-    new_pp % next => NULL()
-!
-    if ( associated(proclist % last) ) then
-        ! the list is not empty, let 'proc' be the next after the last (ie. the last one).
-        proclist % last % next => new_pp
-    else
-        ! the list has just been initialized. Let 'proc' be the first one.
-        proclist % first => new_pp
-    endif
-    ! anyway, for next time 'proc' will be the last one. 
-    proclist % last => new_pp
-    proclist % nitems = proclist % nitems + 1
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_pl_append
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_pl_print_array ( proclist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List), intent(in) :: proclist
-!
-    type(Agrif_Proc_p), pointer :: pp
-    type(Agrif_Proc),   pointer :: proc
-!
-    pp => proclist % first
-!
-    write(*,'("/-------+-----+-----+------+------+------+------+------\")')
-    write(*,'("| iproc | ipx | ipy | imin | imax | jmin | jmax | grid |")')
-    write(*,'("|-------+-----+-----+------+------+------+------+------|")')
-    do while ( associated(pp) )
-        proc => pp % proc
-        write(*,'("|",i6," |",i4," |",i4," |",i5," :",i5," |",i5," :",i5," | ",i4," |")') &
-            proc % pn, proc % pi, proc % pj, proc % imin(1), proc % imax(1), proc % imin(2), proc % imax(2), &
-            proc % grid_id
-        pp => pp % next
-    enddo
-    write(*,'("\-------+-----+-----+------+------+------+------+------/")')
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_pl_print_array
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_pl_print ( proclist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List), intent(in) :: proclist
-!
-    type(Agrif_Proc_p), pointer :: pp
-!
-    pp => proclist % first
-    do while ( associated(pp) )
-        write(*,'(i0,",")',advance='no') pp % proc % pn
-        pp => pp % next
-    enddo
-    write(*,*)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_pl_print
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_pl_copy ( proclist, copy )
-!
-!< Carries out a copy of 'proclist' into 'copy'
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List), intent(in)    :: proclist
-    type(Agrif_Proc_List), intent(out)   :: copy
-!
-    type(Agrif_Proc_p),    pointer    :: pp
-!
-    call Agrif_pl_clear(copy)
-!
-    pp => proclist % first
-    do while ( associated(pp) )
-        call Agrif_pl_append( copy, pp % proc )
-        pp => pp % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_pl_copy
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_pl_deep_copy ( proclist, copy )
-!
-!< Carries out a deep copy of 'proclist' into 'copy'
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List), intent(in)    :: proclist
-    type(Agrif_Proc_List), intent(out)   :: copy
-!
-    type(Agrif_Proc_p), pointer :: pp
-    type(Agrif_Proc),   pointer :: new_proc
-!
-    call Agrif_pl_clear(copy)
-!
-    pp => proclist % first
-    do while ( associated(pp) )
-        allocate( new_proc )
-        new_proc = pp % proc
-        call Agrif_pl_append( copy, new_proc )
-        pp => pp % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_pl_deep_copy
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_pl_clear ( proclist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List), intent(inout)  :: proclist
-!
-    type(Agrif_Proc_p), pointer    :: pp, ppd
-!
-    pp => proclist % first
-!    
-    do while( associated(pp) )
-        ppd => pp
-        pp  => pp % next
-        deallocate(ppd)
-    enddo
-    
-    proclist % first => NULL()
-    proclist % last  => NULL()
-    proclist % nitems = 0
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_pl_clear
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_pl_to_array ( proclist, procarray )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List),                       intent(in)   :: proclist
-    type(Agrif_Proc), dimension(:), allocatable, intent(out)  :: procarray
-!
-    type(Agrif_Proc_p), pointer   :: pp
-!
-    allocate( procarray(1:proclist % nitems) )
-!
-    pp => proclist % first
-    do while ( associated(pp) )
-        procarray(pp%proc%pn+1) = pp % proc
-        pp => pp % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_pl_to_array
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_pl_search_proc ( proclist, rank ) result ( proc )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Proc_List), intent(in)   :: proclist
-    integer,               intent(in)   :: rank
-!
-    type(Agrif_Proc_p), pointer :: pp
-    type(Agrif_Proc),   pointer :: proc
-    logical :: found
-!
-    found = .false.
-    proc => NULL()
-    pp => proclist % first
-    do while ( .not.found .and. associated(pp) )
-        if ( pp % proc % pn == rank ) then
-            proc => pp % proc
-            return
-        else
-            pp => pp % next
-        endif
-    enddo
-!---------------------------------------------------------------------------------------------------
-end function Agrif_pl_search_proc
-!===================================================================================================
-!
-end module Agrif_Procs
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 10251)
@@ -0,0 +1,937 @@
+!
+! $Id: modsauv.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Save  
+C
+      Module Agrif_Save 
+C
+CCC   Description:   
+CCC   Module for the initialization by copy of the grids created by clustering.
+C
+C     Modules used:
+C      
+      Use Agrif_Types
+      Use Agrif_Link
+      Use Agrif_Arrays
+      Use Agrif_Variables
+C
+      IMPLICIT NONE
+C
+      Contains
+C     Definition of procedures contained in this module.
+C
+C
+      Subroutine Agrif_Deallocate_Arrays(Var)
+      type(Agrif_Variable), pointer :: Var
+      
+            if (ALLOCATED(var%array1)) then
+               Deallocate(var%array1)
+            endif
+            if (ALLOCATED(var%array2)) then
+               Deallocate(var%array2)
+            endif
+            if (ALLOCATED(var%array3)) then
+               Deallocate(var%array3)
+            endif
+            if (ALLOCATED(var%array4)) then
+               Deallocate(var%array4)
+            endif
+            if (ALLOCATED(var%array5)) then
+               Deallocate(var%array5)
+            endif
+            if (ALLOCATED(var%array6)) then
+               Deallocate(var%array6)
+            endif
+C
+            if (ALLOCATED(var%darray1)) then
+               Deallocate(var%darray1)
+            endif
+            if (ALLOCATED(var%darray2)) then
+               Deallocate(var%darray2)
+            endif
+            if (ALLOCATED(var%darray3)) then
+               Deallocate(var%darray3)
+            endif
+            if (ALLOCATED(var%darray4)) then
+               Deallocate(var%darray4)
+            endif
+            if (ALLOCATED(var%darray5)) then
+               Deallocate(var%darray5)
+            endif
+            if (ALLOCATED(var%darray6)) then
+               Deallocate(var%darray6)
+            endif
+C
+            if (ALLOCATED(var%larray1)) then
+               Deallocate(var%larray1)
+            endif
+            if (ALLOCATED(var%larray2)) then
+               Deallocate(var%larray2)
+            endif
+            if (ALLOCATED(var%larray3)) then
+               Deallocate(var%larray3)
+            endif
+            if (ALLOCATED(var%larray4)) then
+               Deallocate(var%larray4)
+            endif
+            if (ALLOCATED(var%larray5)) then
+               Deallocate(var%larray5)
+            endif
+            if (ALLOCATED(var%larray6)) then
+               Deallocate(var%larray6)
+            endif
+C
+            if (ALLOCATED(var%iarray1)) then
+               Deallocate(var%iarray1)
+            endif
+            if (ALLOCATED(var%iarray2)) then
+               Deallocate(var%iarray2)
+            endif
+            if (ALLOCATED(var%iarray3)) then
+               Deallocate(var%iarray3)
+            endif
+            if (ALLOCATED(var%iarray4)) then
+               Deallocate(var%iarray4)
+            endif
+            if (ALLOCATED(var%iarray5)) then
+               Deallocate(var%iarray5)
+            endif
+            if (ALLOCATED(var%iarray6)) then
+               Deallocate(var%iarray6)
+            endif
+C
+            if (ALLOCATED(var%carray1)) then
+               Deallocate(var%carray1)
+            endif
+            if (ALLOCATED(var%carray2)) then
+               Deallocate(var%carray2)
+            endif
+C
+            if (associated(var%oldvalues2D)) then
+               Deallocate(var%oldvalues2D)
+            endif
+            if (associated(var%interpIndex)) then
+               Deallocate(var%interpIndex)
+            endif
+            
+            if (associated(var%posvar)) then
+               Deallocate(var%posvar)
+            endif     
+            
+            if (associated(var%interptab)) then
+               Deallocate(var%interptab)
+            endif
+            
+      Return
+      End Subroutine Agrif_Deallocate_Arrays    
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_data_before
+C     **************************************************************************
+C
+      Subroutine Agrif_Free_data_before(Agrif_Gr)
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr ! Pointer on the current grid
+      INTEGER i 
+      Type(Agrif_List_Variables), pointer :: parcours      
+C
+C   
+      do i = 1 , AGRIF_NbVariables
+         if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
+C 
+            call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
+            
+       endif
+           
+C
+       if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then
+         Call Agrif_Free_list_interp
+     &                          (Agrif_Gr%tabvars(i)%var%list_interp)
+       endif                             
+C
+       if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
+            Deallocate(Agrif_Gr%tabvars(i)%var)
+C 
+        endif
+      enddo
+      
+      parcours => Agrif_Gr%variables
+    
+      do i=1,Agrif_Gr%NbVariables
+       if (.NOT. parcours%pvar%var%root_var%restaure) then
+        call Agrif_Deallocate_Arrays(parcours%pvar%var)
+       endif
+        if (associated(parcours%pvar%var%list_interp)) then
+           Call Agrif_Free_list_interp
+     &                          (parcours%pvar%var%list_interp)
+         endif                             
+C
+       if ( .NOT. parcours%pvar%var%root_var % restaure) then
+            Deallocate(parcours%pvar%var)
+C 
+        endif
+        parcours => parcours%nextvariable
+      enddo
+C
+C 
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+         if ( Agrif_Probdim .EQ. 1 ) Deallocate(Agrif_Gr%tabpoint1D)
+         if ( Agrif_Probdim .EQ. 2 ) Deallocate(Agrif_Gr%tabpoint2D)
+         if ( Agrif_Probdim .EQ. 3 ) Deallocate(Agrif_Gr%tabpoint3D)
+      endif
+C          
+      Return
+C
+C
+      End Subroutine Agrif_Free_data_before
+C
+C
+      Recursive Subroutine Agrif_Free_list_interp(list_interp)
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      
+      if (associated(list_interp%suiv))
+     &      Call Agrif_Free_list_interp(list_interp%suiv)
+     
+#ifdef key_mpp_mpi
+       Deallocate(list_interp%interp_loc%tab4t)
+       Deallocate(list_interp%interp_loc%memberinall)
+       Deallocate(list_interp%interp_loc%sendtoproc1)
+       Deallocate(list_interp%interp_loc%recvfromproc1)
+#endif
+       Deallocate(list_interp%interp_loc)
+       Deallocate(list_interp)
+       Nullify(list_interp)
+
+      End Subroutine Agrif_Free_list_interp      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_data_after
+C     **************************************************************************
+C      
+      Subroutine Agrif_Free_data_after(Agrif_Gr)
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C
+      
+C
+C     Pointer argument    
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
+      INTEGER i
+      Type(Agrif_List_Variables), pointer :: parcours, rootparcours
+C
+C      
+      do i = 1 , AGRIF_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
+            
+         call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
+         !
+            Deallocate(Agrif_Gr%tabvars(i)%var)
+! 
+         endif
+      enddo
+      
+      parcours => Agrif_Gr%variables
+      rootparcours=>Agrif_Mygrid%variables
+    
+      do i=1,Agrif_Gr%NbVariables
+       if (rootparcours%pvar%var%restaure) then
+        call Agrif_Deallocate_Arrays(parcours%pvar%var)
+      
+            Deallocate(parcours%pvar%var)
+C 
+        endif
+        parcours => parcours%nextvariable
+        rootparcours => rootparcours%nextvariable        
+      enddo
+            
+C
+C      
+      Return
+C
+C
+      End Subroutine Agrif_Free_data_after      
+C
+C
+CC    **************************************************************************
+CCC   Subroutine AGRIF_CopyFromold_All
+C     **************************************************************************
+C
+      Recursive Subroutine AGRIF_CopyFromold_All(g,oldchildgrids)
+C
+CCC   Description:
+CCC   Routine called in the Agrif_Init_Hierarchy procedure 
+C       (Agrif_Clustering module). 
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
+      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
+C
+C     Local pointer
+      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure 
+      REAL g_eps,eps,oldgrid_eps
+      INTEGER :: out
+      INTEGER :: iii
+C
+      out = 0
+C                                                                           
+      parcours => oldchildgrids  
+C
+      do while (associated(parcours))
+C 
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+C        
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1 , Agrif_Probdim
+               g_eps = min(g_eps,g % Agrif_d(iii))
+               oldgrid_eps = min(oldgrid_eps,
+     &                       parcours % gr % Agrif_d(iii))
+            enddo
+C
+            eps = min(g_eps,oldgrid_eps)/100.                  
+C
+            do iii = 1 , Agrif_Probdim
+
+               if (g % Agrif_d(iii) .LT. 
+     &             (parcours % gr % Agrif_d(iii) - eps)) then
+C            
+                   parcours => parcours % next
+C            
+                   out = 1
+C   
+                   Exit
+C             
+               endif
+C      
+            enddo
+        if ( out .EQ. 1 ) Cycle
+C
+            Call AGRIF_CopyFromOld(g,parcours%gr)
+C
+        endif
+C                     
+        Call Agrif_CopyFromold_All
+     &             (g, parcours % gr % child_grids)
+C        
+        parcours => parcours % next
+C        
+      enddo
+C
+C     
+      Return      
+C
+C
+      End Subroutine AGRIF_CopyFromold_All
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_CopyFromold
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopyFromold(Agrif_New_Gr,Agrif_Old_Gr)
+C
+CCC   Description:
+CCC   Call to the Agrif_Copy procedure.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
+      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      INTEGER :: i
+C
+C      
+      do i = 1 , AGRIF_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure ) then
+C
+            Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
+     &           Agrif_New_Gr % tabvars(i),
+     &           Agrif_Old_Gr % tabvars(i))
+C
+        endif
+      enddo
+
+C      
+C            
+      Return
+C
+C      
+      End Subroutine Agrif_CopyFromold
+      
+CC    **************************************************************************
+CCC   Subroutine AGRIF_CopyFromold_AllOneVar
+C     **************************************************************************
+C
+      Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids,
+     &   indic)
+C
+CCC   Description:
+CCC   Routine called in the Agrif_Init_Hierarchy procedure 
+C       (Agrif_Clustering module). 
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
+      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
+      integer :: indic
+C
+C     Local pointer
+      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure 
+      REAL g_eps,eps,oldgrid_eps
+      INTEGER :: out
+      INTEGER :: iii
+C
+      out = 0
+C                                                                           
+      parcours => oldchildgrids  
+C
+      do while (associated(parcours))
+C 
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+C        
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1 , Agrif_Probdim
+               g_eps = min(g_eps,g % Agrif_d(iii))
+               oldgrid_eps = min(oldgrid_eps,
+     &                       parcours % gr % Agrif_d(iii))
+            enddo
+C
+            eps = min(g_eps,oldgrid_eps)/100.                  
+C
+            do iii = 1 , Agrif_Probdim
+
+               if (g % Agrif_d(iii) .LT. 
+     &             (parcours % gr % Agrif_d(iii) - eps)) then
+C            
+                   parcours => parcours % next
+C            
+                   out = 1
+C   
+                   Exit
+C             
+               endif
+C      
+            enddo
+        if ( out .EQ. 1 ) Cycle
+C
+            Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic)
+C
+        endif
+C                     
+        Call Agrif_CopyFromold_AllOneVar
+     &             (g, parcours % gr % child_grids,indic)
+C        
+        parcours => parcours % next
+C        
+      enddo
+C
+C     
+      Return      
+C
+C
+      End Subroutine AGRIF_CopyFromold_AllOneVar
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_CopyFromoldOneVar
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr,
+     &    indic)
+C
+CCC   Description:
+CCC   Call to the Agrif_Copy procedure.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
+      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      INTEGER :: indic
+      INTEGER :: i
+      TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars      
+C
+C      
+      tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic)
+      oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic)
+
+      Call Agrif_Nbdim_Allocation(tabvars%var,
+     &  tabvars%var%lb,tabvars%var%ub,
+     &  tabvars%var%nbdim)
+     
+      Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
+     &           tabvars,oldtabvars)
+
+
+C      
+C            
+      Return
+C
+C      
+      End Subroutine Agrif_CopyFromoldOneVar      
+      
+C
+C
+CC
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Copy
+C     **************************************************************************
+C      
+      Subroutine Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,New_Var,Old_Var)
+C     
+CCC   Description:
+CCC   Sets arguments of the Agrif_UpdatenD procedures, n being the number of 
+CCC   DIMENSION of the grid variable.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr   ! Pointer on the current grid
+      TYPE(Agrif_Grid), Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      TYPE(Agrif_Pvariable) :: New_Var, Old_Var
+      INTEGER :: nbdim                  ! Number of dimensions of the current 
+                                        ! grid      
+      INTEGER,DIMENSION(6) :: pttabnew  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: petabnew  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: pttabold  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: petabold  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: nbtabold  ! Number of cells in each direction
+      
+      INTEGER,DIMENSION(6) :: nbtabnew  ! Number of cells in each direction   
+      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
+                                            ! root grid
+      REAL, DIMENSION(6) :: snew,sold
+      REAL, DIMENSION(6) :: dsnew,dsold                              
+      REAL :: eps
+      INTEGER :: n
+C
+C  
+      root => New_Var % var % root_var 
+C      
+      nbdim = root % nbdim
+C         
+      do n=1,nbdim
+C  
+        select case(root % interptab(n))
+C        
+        case('x')                
+C
+          pttabnew(n) = root % point(1)
+C        
+          pttabold(n) = root % point(1)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(1)
+C
+          sold(n) = Agrif_Old_Gr % Agrif_x(1) 
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(1)
+C
+          dsold(n) = Agrif_Old_Gr % Agrif_d(1)
+C                      
+          if (root % posvar(n) .EQ. 1) then
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1)         
+C        
+            else
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1) - 1
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1) - 1
+C
+              snew(n) = snew(n) + dsnew(n)/2.
+C
+              sold(n) = sold(n) + dsold(n)/2.
+C        
+          endif           
+C        
+        case('y')
+C        
+          pttabnew(n) = root % point(2)
+C        
+          pttabold(n) = root % point(2)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(2)
+C        
+          sold(n) = Agrif_Old_Gr % Agrif_x(2)
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(2)
+C        
+          dsold(n) = Agrif_Old_Gr % Agrif_d(2)
+C                
+          if (root % posvar(n) .EQ. 1) then
+C        
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2)         
+C        
+            else
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2) - 1
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2) - 1
+C
+              snew(n) = snew(n) + dsnew(n)/2.
+C
+              sold(n) = sold(n) + dsold(n)/2.                    
+C        
+          endif 
+C        
+        case('z')
+C        
+          pttabnew(n) = root % point(3)
+C        
+          pttabold(n) = root % point(3)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(3)
+C        
+          sold(n) = Agrif_Old_Gr % Agrif_x(3)
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(3)
+C        
+          dsold(n) = Agrif_Old_Gr % Agrif_d(3)
+C                
+          if (root % posvar(n) .EQ. 1) then
+C        
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3)         
+C        
+            else
+C          
+             petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3) - 1
+C          
+             petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3) - 1
+C
+             snew(n) = snew(n) + dsnew(n)/2.
+C
+             sold(n) = sold(n) + dsold(n)/2.                   
+C        
+          endif
+C          
+        case('N')
+C        
+          Call Agrif_nbdim_Get_bound(New_Var%var,
+     &                           pttabnew(n),petabnew(n),
+     &                           n,nbdim)
+C        
+          pttabold(n) = pttabnew(n)
+C      
+          petabold(n) = petabnew(n)
+C              
+          snew(n) = 0.
+C      
+          sold(n) = 0. 
+C      
+          dsnew(n) = 1.
+C      
+          dsold(n) = 1.
+C        
+        end select
+C      
+      enddo
+C      
+      do n = 1,nbdim
+C      
+        nbtabnew(n) = petabnew(n) - pttabnew(n)
+C      
+        nbtabold(n) = petabold(n) - pttabold(n)      
+C 
+      enddo      
+C
+      eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim)))
+C     
+      eps = eps/100.      
+C      
+      do n = 1,nbdim
+C      
+        if (snew(n) .GT. (sold(n)+dsold(n)*nbtabold(n)+eps)) Return
+C      
+        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) .LT. sold(n)) Return
+C      
+      enddo
+C            
+C
+      Call AGRIF_CopynD
+     &        (New_Var,Old_Var,pttabold,petabold,pttabnew,petabnew,
+     &         sold,snew,dsold,dsnew,nbdim) 
+C      
+C 
+      Return
+C      
+C
+      End Subroutine Agrif_Copy
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CopynD
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopynD(New_Var,Old_Var,pttabold,petabold,
+     &                        pttabnew,petabnew,sold,snew,dsold,
+     &                        dsnew,nbdim)
+C     
+CCC   Description:
+CCC   Copy of the nD New_Var variable from the nD Old_Var variable.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C
+      INTEGER :: nbdim
+      TYPE(Agrif_Pvariable) :: New_Var, Old_Var     
+      INTEGER,DIMENSION(nbdim) :: pttabnew 
+      INTEGER,DIMENSION(nbdim) :: petabnew
+      INTEGER,DIMENSION(nbdim) :: pttabold
+      INTEGER,DIMENSION(nbdim) :: petabold      
+      REAL, DIMENSION(nbdim) :: snew,sold
+      REAL, DIMENSION(nbdim) :: dsnew,dsold 
+C
+      INTEGER :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
+C
+      REAL, DIMENSION(nbdim) :: dim_gmin,dim_gmax
+      REAL, DIMENSION(nbdim) :: dim_newmin,dim_newmax
+      REAL, DIMENSION(nbdim) :: dim_min
+      INTEGER, DIMENSION(nbdim) :: ind_gmin,ind_newmin
+      INTEGER, DIMENSION(nbdim) ::  ind_newmax
+C               
+C
+      do i = 1,nbdim
+C      
+        dim_gmin(i) = sold(i)
+        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
+C 
+        dim_newmin(i) = snew(i)
+        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
+C
+      enddo         
+C
+      do i = 1,nbdim
+C  
+        if (dim_gmax(i) .LT. dim_newmin(i)) Return
+C      
+        if (dim_gmin(i) .GT. dim_newmax(i)) Return
+C
+      enddo
+C
+C
+      do i = 1,nbdim
+C 
+        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),
+     &                      dim_newmin(i))-dim_newmin(i))/dsnew(i)) 
+C      
+        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
+C      
+        ind_gmin(i) = pttabold(i) + nint((dim_min(i)-
+     &                dim_gmin(i))/dsold(i))      
+C
+        ind_newmax(i) = pttabnew(i) 
+     &                  + int((min(dim_gmax(i),dim_newmax(i))
+     &                         -dim_newmin(i))/dsnew(i))
+C
+      enddo 
+C
+C
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         i0 = ind_gmin(1)
+         do i = ind_newmin(1),ind_newmax(1)
+            New_Var % var % array1(i) =
+     &      Old_Var % var % array1(i0)
+            New_Var % var % restore1D(i) = 1   
+         i0 = i0 + int(dsnew(1)/dsold(1))
+         enddo
+      CASE (2)
+
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+           New_Var % var % array2(i,j) =
+     &            Old_Var % var % array2(i0,j0)
+           New_Var % var % restore2D(i,j) = 1
+               j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (3)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+           New_Var % var % array3(i,j,k) =
+     &                  Old_Var % var % array3(i0,j0,k0)
+           New_Var % var % restore3D(i,j,k) = 1   
+                     k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (4)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+           New_Var % var % array4(i,j,k,l) =
+     &                        Old_Var % var % array4(i0,j0,k0,l0)
+           New_Var % var % restore4D(i,j,k,l) = 1   
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (5)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+        m0 = ind_gmin(5)
+        do m = ind_newmin(5),ind_newmax(5)
+           New_Var % var % array5(i,j,k,l,m) =
+     &                        Old_Var % var % array5(i0,j0,k0,l0,m0)
+           New_Var % var % restore5D(i,j,k,l,m) = 1
+        m0 = m0 + int(dsnew(5)/dsold(5)) 
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (6)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+        m0 = ind_gmin(5)
+        do m = ind_newmin(5),ind_newmax(5)
+        n0 = ind_gmin(6)
+        do n = ind_newmin(6),ind_newmax(6)
+           New_Var % var % array6(i,j,k,l,m,n) =
+     &                        Old_Var % var % array6(i0,j0,k0,l0,m0,n0)
+           New_Var % var % restore6D(i,j,k,l,m,n) = 1
+        n0 = n0 + int(dsnew(6)/dsold(6)) 
+        enddo
+        m0 = m0 + int(dsnew(5)/dsold(5)) 
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      END SELECT
+C           
+      Return
+C
+C
+      End Subroutine Agrif_CopynD                    
+C
+C
+C
+      End module Agrif_Save
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 10250)
+++ 	(revision )
@@ -1,663 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!> Module Agrif_Save
-!!
-!! Module for the initialization by copy of the grids created by clustering.
-!
-module Agrif_Save
-!
-    use Agrif_Types
-    use Agrif_Link
-    use Agrif_Arrays
-    use Agrif_Variables
-!
-    implicit none
-!
-contains
-!
-!===================================================================================================
-! subroutine Agrif_deallocate_Arrays
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_deallocate_Arrays ( var )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), pointer :: var
-!
-    if (allocated(var%array1))  deallocate(var%array1)
-    if (allocated(var%array2))  deallocate(var%array2)
-    if (allocated(var%array3))  deallocate(var%array3)
-    if (allocated(var%array4))  deallocate(var%array4)
-    if (allocated(var%array5))  deallocate(var%array5)
-    if (allocated(var%array6))  deallocate(var%array6)
-!
-    if (allocated(var%darray1)) deallocate(var%darray1)
-    if (allocated(var%darray2)) deallocate(var%darray2)
-    if (allocated(var%darray3)) deallocate(var%darray3)
-    if (allocated(var%darray4)) deallocate(var%darray4)
-    if (allocated(var%darray5)) deallocate(var%darray5)
-    if (allocated(var%darray6)) deallocate(var%darray6)
-!
-    if (allocated(var%sarray1)) deallocate(var%sarray1)
-    if (allocated(var%sarray2)) deallocate(var%sarray2)
-    if (allocated(var%sarray3)) deallocate(var%sarray3)
-    if (allocated(var%sarray4)) deallocate(var%sarray4)
-    if (allocated(var%sarray5)) deallocate(var%sarray5)
-    if (allocated(var%sarray6)) deallocate(var%sarray6)
-!
-!
-    if (associated(var%oldvalues2D))    deallocate(var%oldvalues2D)
-    if (allocated(var%posvar))          deallocate(var%posvar)
-    if (allocated(var%interptab))       deallocate(var%interptab)
-    if (allocated(var%coords))          deallocate(var%coords)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_deallocate_Arrays
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_deallocate_Arrays_c ( var_c )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable_c), pointer :: var_c
-!
-    if (allocated(var_c%carray1)) deallocate(var_c%carray1)
-    if (allocated(var_C%carray2)) deallocate(var_c%carray2)
-!
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_deallocate_Arrays_c
-!===================================================================================================
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_deallocate_Arrays_l ( var_l )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable_l), pointer :: var_l
-!
-!
-    if (allocated(var_l%larray1)) deallocate(var_l%larray1)
-    if (allocated(var_l%larray2)) deallocate(var_l%larray2)
-    if (allocated(var_l%larray3)) deallocate(var_l%larray3)
-    if (allocated(var_l%larray4)) deallocate(var_l%larray4)
-    if (allocated(var_l%larray5)) deallocate(var_l%larray5)
-    if (allocated(var_l%larray6)) deallocate(var_l%larray6)
-!
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_deallocate_Arrays_l
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_deallocate_Arrays_i ( var_i )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable_i), pointer :: var_i
-!
-!
-    if (allocated(var_i%iarray1)) deallocate(var_i%iarray1)
-    if (allocated(var_i%iarray2)) deallocate(var_i%iarray2)
-    if (allocated(var_i%iarray3)) deallocate(var_i%iarray3)
-    if (allocated(var_i%iarray4)) deallocate(var_i%iarray4)
-    if (allocated(var_i%iarray5)) deallocate(var_i%iarray5)
-    if (allocated(var_i%iarray6)) deallocate(var_i%iarray6)
-!
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_deallocate_Arrays_i
-!
-!===================================================================================================
-!  subroutine Agrif_Free_data_before
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Free_data_before ( Agrif_Gr )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: Agrif_Gr ! Pointer on the current grid
-!
-    integer :: i
-    type(Agrif_Variables_List), pointer :: parcours
-    type(Agrif_Variable),       pointer :: var
-    type(Agrif_Variable_c),     pointer :: var_c
-    type(Agrif_Variable_r),     pointer :: var_r
-    type(Agrif_Variable_l),     pointer :: var_l
-    type(Agrif_Variable_i),     pointer :: var_i
-!
-    do i = 1,Agrif_NbVariables(0)
-!
-        var => Agrif_Gr % tabvars(i)
-!
-        if ( .NOT. Agrif_Mygrid % tabvars(i) % restore ) then
-            call Agrif_deallocate_Arrays(var)
-        endif
-!
-        if (associated(var%list_interp)) then
-            call Agrif_Free_list_interp(var%list_interp)
-        endif
-!
-    enddo
-    do i=1,Agrif_NbVariables(1)
-        var_c => Agrif_Gr % tabvars_c(i)
-        call Agrif_deallocate_Arrays_c(var_c)
-    enddo
-    do i=1,Agrif_NbVariables(3)
-        var_l => Agrif_Gr % tabvars_l(i)
-        call Agrif_deallocate_Arrays_l(var_l)
-    enddo
-    do i=1,Agrif_NbVariables(4)
-        var_i => Agrif_Gr % tabvars_i(i)
-        call Agrif_deallocate_Arrays_i(var_i)
-    enddo
-
-    parcours => Agrif_Gr % variables
-
-    do i = 1,Agrif_Gr%NbVariables
-!
-        if ( .NOT. parcours%var%root_var % restore ) then
-            call Agrif_deallocate_Arrays(parcours%var)
-        endif
-!
-        if (associated(parcours%var%list_interp)) then
-            call Agrif_Free_list_interp(parcours%var%list_interp)
-        endif
-!
-        if ( .NOT. parcours%var%root_var % restore ) then
-            deallocate(parcours%var)
-        endif
-!
-        parcours => parcours % next
-!
-    enddo
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
-        if ( Agrif_Probdim == 1 ) deallocate(Agrif_Gr%tabpoint1D)
-        if ( Agrif_Probdim == 2 ) deallocate(Agrif_Gr%tabpoint2D)
-        if ( Agrif_Probdim == 3 ) deallocate(Agrif_Gr%tabpoint3D)
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Free_data_before
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Free_list_interp
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Free_list_interp ( list_interp )
-!---------------------------------------------------------------------------------------------------
-      type(Agrif_List_Interp_Loc), pointer :: list_interp
-!
-      if (associated(list_interp%suiv)) call Agrif_Free_list_interp(list_interp%suiv)
-
-#if defined AGRIF_MPI
-       deallocate(list_interp%interp_loc%tab4t)
-       deallocate(list_interp%interp_loc%memberinall)
-       deallocate(list_interp%interp_loc%sendtoproc1)
-       deallocate(list_interp%interp_loc%recvfromproc1)
-#endif
-       deallocate(list_interp%interp_loc)
-       deallocate(list_interp)
-       nullify(list_interp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Free_list_interp
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Free_data_after
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Free_data_after ( Agrif_Gr )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: Agrif_Gr  !< Pointer on the current grid
-!
-    integer :: i
-    type(Agrif_Variables_List), pointer :: parcours, rootparcours
-    type(Agrif_Variable),       pointer :: var
-!
-    do i = 1,Agrif_NbVariables(0)
-        if ( Agrif_Mygrid % tabvars(i) % restore ) then
-            var => Agrif_Gr%tabvars(i)
-            call Agrif_deallocate_Arrays(var)
-        endif
-    enddo
-!
-    parcours => Agrif_Gr%variables
-    rootparcours => Agrif_Mygrid%variables
-!
-    do i = 1,Agrif_Gr%NbVariables
-        if (rootparcours%var % restore ) then
-            call Agrif_deallocate_Arrays(parcours%var)
-            deallocate(parcours%var)
-        endif
-        parcours => parcours % next
-        rootparcours => rootparcours % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Free_data_after
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_CopyFromOld_All
-!
-!> Called in Agrif_Clustering#Agrif_Init_Hierarchy.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_CopyFromOld_All ( g, oldchildlist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer, intent(inout) :: g   !< Pointer on the current grid
-    type(Agrif_Grid_List),     intent(in)    :: oldchildlist
-!
-    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    real    :: g_eps, eps, oldgrid_eps
-    integer :: out
-    integer :: iii
-!
-    out = 0
-!
-    parcours => oldchildlist % first
-!
-    do while (associated(parcours))
-!
-        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
-!
-            g_eps = huge(1.)
-            oldgrid_eps = huge(1.)
-            do iii = 1,Agrif_Probdim
-                g_eps = min(g_eps,g % Agrif_dx(iii))
-                oldgrid_eps = min(oldgrid_eps, parcours % gr % Agrif_dx(iii))
-            enddo
-!
-            eps = min(g_eps,oldgrid_eps)/100.
-!
-            do iii = 1,Agrif_Probdim
-                if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then
-                    parcours => parcours % next
-                    out = 1
-                    exit
-                endif
-            enddo
-!
-            if ( out == 1 ) cycle
-!
-            call Agrif_CopyFromOld(g,parcours%gr)
-!
-        endif
-!
-        call Agrif_CopyFromOld_All(g,parcours % gr % child_list)
-!
-        parcours => parcours % next
-!
-      enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_CopyFromOld_All
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_CopyFromOld
-!
-!> Call to the Agrif_Copy procedure.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_CopyFromOld ( new_gr, old_gr )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer, intent(inout) :: new_gr  !< Pointer on the current grid
-    type(Agrif_Grid), pointer, intent(inout) :: old_gr  !< Pointer on an old grid
-!
-    type(Agrif_Variable), pointer   :: new_var
-    type(Agrif_Variable), pointer   :: old_var
-    integer :: i
-!
-    do i = 1,Agrif_NbVariables(0)
-        if ( Agrif_Mygrid % tabvars(i) % restore ) then
-            old_var => old_gr % tabvars(i)
-            new_var => new_gr % tabvars(i)
-            call Agrif_Copy(new_gr, old_gr, new_var, old_var )
-        endif
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_CopyFromOld
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_CopyFromOld_AllOneVar
-!
-!> Called in Agrif_Clustering#Agrif_Init_Hierarchy.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_CopyFromOld_AllOneVar ( g, oldchildlist, indic )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer, intent(inout) :: g            !< Pointer on the current grid
-    type(Agrif_Grid_List),     intent(in)    :: oldchildlist
-    integer,                   intent(in)    :: indic
-!
-    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    real    :: g_eps,eps,oldgrid_eps
-    integer :: out
-    integer :: iii
-!
-    out = 0
-!
-    parcours => oldchildlist % first
-!
-    do while (associated(parcours))
-!
-        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
-!
-            g_eps = huge(1.)
-            oldgrid_eps = huge(1.)
-            do iii = 1,Agrif_Probdim
-                g_eps = min(g_eps,g % Agrif_dx(iii))
-                oldgrid_eps = min(oldgrid_eps,parcours % gr % Agrif_dx(iii))
-            enddo
-!
-            eps = min(g_eps,oldgrid_eps)/100.
-!
-            do iii = 1,Agrif_Probdim
-                if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then
-                    parcours => parcours % next
-                    out = 1
-                    exit
-                endif
-            enddo
-
-            if ( out == 1 ) cycle
-!
-            call Agrif_CopyFromOldOneVar(g,parcours%gr,indic)
-!
-        endif
-!
-        call Agrif_CopyFromOld_AllOneVar(g,parcours%gr % child_list,indic)
-!
-        parcours => parcours % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_CopyFromOld_AllOneVar
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_CopyFromOldOneVar
-!
-!> Call to Agrif_Copy
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_CopyFromOldOneVar ( new_gr, old_gr, indic )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer, intent(inout) :: new_gr     !< Pointer on the current grid
-    type(Agrif_Grid), pointer, intent(in)    :: old_gr     !< Pointer on an old grid
-    integer,                   intent(in)    :: indic
-!
-    type(Agrif_Variable),  pointer  :: new_var, old_var
-!
-    new_var => Agrif_Search_Variable(new_gr, -indic)
-    old_var => Agrif_Search_Variable(old_gr, -indic)
-!
-    call Agrif_array_allocate(new_var,new_var%lb,new_var%ub,new_var%nbdim)
-    call Agrif_Copy(new_gr, old_gr, new_var,old_var)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_CopyFromOldOneVar
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Copy
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Copy ( new_gr, old_gr, new_var, old_var )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid),     pointer, intent(in)       :: new_gr !< Pointer on the current grid
-    type(Agrif_Grid),     pointer, intent(in)       :: old_gr !< Pointer on an old grid
-    type(Agrif_Variable), pointer, intent(inout)    :: new_var
-    type(Agrif_Variable), pointer, intent(in)       :: old_var
-!
-    type(Agrif_Variable), pointer :: root ! Pointer on the variable of the root grid
-    integer               :: nbdim     ! Number of dimensions of the current grid
-    integer, dimension(6) :: pttabnew  ! Indexes of the first point in the domain
-    integer, dimension(6) :: petabnew  ! Indexes of the first point in the domain
-    integer, dimension(6) :: pttabold  ! Indexes of the first point in the domain
-    integer, dimension(6) :: petabold  ! Indexes of the first point in the domain
-    integer, dimension(6) :: nbtabold  ! Number of cells in each direction
-    integer, dimension(6) :: nbtabnew  ! Number of cells in each direction
-    real,    dimension(6) :: snew,sold
-    real,    dimension(6) :: dsnew,dsold
-    real    :: eps
-    integer :: n
-!
-    root => new_var % root_var
-    nbdim = root % nbdim
-!
-    do n = 1,nbdim
-!
-        select case(root % interptab(n))
-!
-        case('x')
-!
-            pttabnew(n) = root % point(n)
-            pttabold(n) = root % point(n)
-            snew(n)  = new_gr % Agrif_x(1)
-            sold(n)  = old_gr % Agrif_x(1)
-            dsnew(n) = new_gr % Agrif_dx(1)
-            dsold(n) = old_gr % Agrif_dx(1)
-!
-            if (root % posvar(n) == 1) then
-                petabnew(n) = pttabnew(n) + new_gr % nb(1)
-                petabold(n) = pttabold(n) + old_gr % nb(1)
-            else
-                petabnew(n) = pttabnew(n) + new_gr % nb(1) - 1
-                petabold(n) = pttabold(n) + old_gr % nb(1) - 1
-                snew(n) = snew(n) + dsnew(n)/2.
-                sold(n) = sold(n) + dsold(n)/2.
-            endif
-!
-        case('y')
-!
-            pttabnew(n) = root % point(n)
-            pttabold(n) = root % point(n)
-            snew(n) = new_gr % Agrif_x(2)
-            sold(n) = old_gr % Agrif_x(2)
-            dsnew(n) = new_gr % Agrif_dx(2)
-            dsold(n) = old_gr % Agrif_dx(2)
-!
-            if (root % posvar(n) == 1) then
-                petabnew(n) = pttabnew(n) + new_gr % nb(2)
-                petabold(n) = pttabold(n) + old_gr % nb(2)
-            else
-                petabnew(n) = pttabnew(n) + new_gr % nb(2) - 1
-                petabold(n) = pttabold(n) + old_gr % nb(2) - 1
-                snew(n) = snew(n) + dsnew(n)/2.
-                sold(n) = sold(n) + dsold(n)/2.
-            endif
-!
-        case('z')
-!
-            pttabnew(n) = root % point(n)
-            pttabold(n) = root % point(n)
-            snew(n)  = new_gr % Agrif_x(3)
-            sold(n)  = old_gr % Agrif_x(3)
-            dsnew(n) = new_gr % Agrif_dx(3)
-            dsold(n) = old_gr % Agrif_dx(3)
-!
-            if (root % posvar(n) == 1) then
-                petabnew(n) = pttabnew(n) + new_gr % nb(3)
-                petabold(n) = pttabold(n) + old_gr % nb(3)
-            else
-                petabnew(n) = pttabnew(n) + new_gr % nb(3) - 1
-                petabold(n) = pttabold(n) + old_gr % nb(3) - 1
-                snew(n) = snew(n) + dsnew(n)/2.
-                sold(n) = sold(n) + dsold(n)/2.
-            endif
-!
-        case('N')
-!
-            call Agrif_get_var_bounds(new_var,pttabnew(n),petabnew(n),n)
-!
-            pttabold(n) = pttabnew(n)
-            petabold(n) = petabnew(n)
-            snew(n) = 0.
-            sold(n) = 0.
-            dsnew(n) = 1.
-            dsold(n) = 1.
-!
-        end select
-!
-    enddo
-!
-    do n = 1,nbdim
-        nbtabnew(n) = petabnew(n) - pttabnew(n)
-        nbtabold(n) = petabold(n) - pttabold(n)
-    enddo
-!
-    eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim))) / 100.
-!
-    do n = 1,nbdim
-        if (snew(n) > (sold(n)+dsold(n)*nbtabold(n)+eps)) return
-        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) < sold(n)) return
-    enddo
-!
-    call Agrif_CopynD(new_var,old_var,pttabold,petabold,pttabnew,petabnew,  &
-                      sold,snew,dsold,dsnew,nbdim)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Copy
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_CopynD
-!
-!> Copy from the nD variable Old_Var the nD variable New_Var
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_CopynD ( new_var, old_var, pttabold, petabold, pttabnew, petabnew, &
-                          sold, snew, dsold, dsnew, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), pointer, intent(inout) :: new_var
-    type(Agrif_Variable), pointer, intent(in)    :: old_var
-    integer, dimension(nbdim),     intent(in)    :: pttabnew
-    integer, dimension(nbdim),     intent(in)    :: petabnew
-    integer, dimension(nbdim),     intent(in)    :: pttabold
-    integer, dimension(nbdim),     intent(in)    :: petabold
-    real,    dimension(nbdim),     intent(in)    :: snew, sold
-    real,    dimension(nbdim),     intent(in)    :: dsnew,dsold
-    integer,                       intent(in)    :: nbdim
-!
-    integer :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
-!
-    real,    dimension(nbdim) :: dim_gmin,   dim_gmax
-    real,    dimension(nbdim) :: dim_newmin, dim_newmax
-    real,    dimension(nbdim) :: dim_min
-    integer, dimension(nbdim) :: ind_gmin,ind_newmin, ind_newmax
-!
-    do i = 1,nbdim
-!
-        dim_gmin(i) = sold(i)
-        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
-!
-        dim_newmin(i) = snew(i)
-        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
-!
-    enddo
-!
-    do i = 1,nbdim
-        if (dim_gmax(i) < dim_newmin(i)) return
-        if (dim_gmin(i) > dim_newmax(i)) return
-    enddo
-!
-    do i = 1,nbdim
-!
-        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),dim_newmin(i))-dim_newmin(i))/dsnew(i))
-        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
-        ind_gmin(i)   = pttabold(i) + nint((dim_min(i)-dim_gmin(i))/dsold(i))
-        ind_newmax(i) = pttabnew(i) + int((min(dim_gmax(i),dim_newmax(i))-dim_newmin(i))/dsnew(i))
-!
-    enddo
-!
-    select case (nbdim)
-!
-    case (1)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-            new_var % array1(i)    = old_var % array1(i0)
-            new_var % restore1D(i) = 1
-            i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-!
-    case (2)
-        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
-            new_var % array2(i,j)    = old_var % array2(i0,j0)
-            new_var % restore2D(i,j) = 1
-            j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-!
-    case (3)
-        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
-            new_var % array3(i,j,k)    =  old_var % array3(i0,j0,k0)
-            new_var % restore3D(i,j,k) = 1
-            k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-!
-    case (4)
-        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
-            new_var % array4(i,j,k,l)    = old_var % array4(i0,j0,k0,l0)
-            new_var % restore4D(i,j,k,l) = 1
-            l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-!
-    case (5)
-        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
-        m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5)
-            new_var % array5(i,j,k,l,m)    = old_var % array5(i0,j0,k0,l0,m0)
-            new_var % restore5D(i,j,k,l,m) = 1
-            m0 = m0 + int(dsnew(5)/dsold(5))
-        enddo
-        l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-!
-    case (6)
-        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
-        m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5)
-        n0 = ind_gmin(6) ; do n = ind_newmin(6),ind_newmax(6)
-            new_var % array6(i,j,k,l,m,n)    = old_var % array6(i0,j0,k0,l0,m0,n0)
-            new_var % restore6D(i,j,k,l,m,n) = 1
-            n0 = n0 + int(dsnew(6)/dsold(6))
-        enddo
-        m0 = m0 + int(dsnew(5)/dsold(5))
-        enddo
-        l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-!
-      end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_CopynD
-!===================================================================================================
-!
-end module Agrif_Save
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 10250)
+++ 	(revision )
@@ -1,640 +1,0 @@
-module Agrif_seq
-!
-    use Agrif_Init
-    use Agrif_Procs
-    use Agrif_Arrays
-!
-    implicit none
-!
-contains
-!
-#if defined AGRIF_MPI
-!===================================================================================================
-function Agrif_seq_allocate_list ( nb_seqs ) result( seqlist )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     :: nb_seqs
-!
-    type(Agrif_Sequence_List), pointer :: seqlist
-!
-    allocate(seqlist)
-    seqlist % nb_seqs = nb_seqs
-    allocate(seqlist % sequences(1:nb_seqs))
-!---------------------------------------------------------------------------------------------------
-end function Agrif_seq_allocate_list
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_seq_add_grid ( seqlist, seq_num, grid )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Sequence_List), intent(inout)    :: seqlist
-    integer,                   intent(in)       :: seq_num
-    type(Agrif_Grid), pointer, intent(in)       :: grid
-!
-    call Agrif_gl_append(seqlist % sequences(seq_num) % gridlist, grid )
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_add_grid
-!===================================================================================================
-!
-!===================================================================================================
-recursive subroutine Agrif_seq_init_sequences ( grid )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(inout)  :: grid
-!
-    type(Agrif_PGrid), pointer  :: gp
-!
-#if defined AGRIF_MPI
-!
-! Build list of required procs for each child grid
-    gp => grid % child_list % first
-    do while ( associated( gp ) )
-        call Agrif_seq_build_required_proclist( gp % gr )
-        gp => gp % next
-    enddo
-!
-! Create integration sequences for the current grid
-    call Agrif_seq_create_proc_sequences( grid )
-    call Agrif_seq_allocate_procs_to_childs( grid )
-!
-! Create new communicators for sequences
-    call Agrif_seq_create_communicators( grid )
-!
-#endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_init_sequences
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_seq_build_required_proclist ( grid )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(inout) :: grid
-!
-    type(Agrif_Grid),      pointer  :: parent_grid
-    type(Agrif_Rectangle), pointer  :: grid_rect
-    type(Agrif_Proc_p),    pointer  :: proc_rect
-    type(Agrif_Proc),      pointer  :: proc
-    logical     :: proc_is_required
-    integer     :: i
-!
-    if ( grid % fixedrank == 0 ) then
-!       grid is the Root
-        if ( grid % required_proc_list % nitems == 0 ) then
-            print*, "### Error Agrif_seq_build_required_proclist: empty proc list."
-            print*, "# -> You should check if Agrif_Init_ProcList() is actually working."
-            stop
-        endif
-        return
-    endif
-!
-    parent_grid => grid % parent
-    grid_rect   => grid % rect_in_parent
-    proc_rect   => parent_grid % proc_def_list % first
-!
-
-    do while ( associated( proc_rect ) )
-
-!
-        proc => proc_rect % proc
-!
-        proc_is_required = .true.
-        do i = 1,Agrif_Probdim
-            proc_is_required = ( proc_is_required             .and. &
-                    ( grid_rect % imin(i) <= proc % imax(i) ) .and. &
-                    ( grid_rect % imax(i) >= proc % imin(i) ) )
-        enddo
-!
-        if ( proc_is_required ) then
-            call Agrif_pl_append(grid % required_proc_list, proc)
-        endif
-        proc_rect => proc_rect % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_build_required_proclist
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_seq_create_proc_sequences ( grid )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(inout)    :: grid
-!
-    type(Agrif_Grid_List), pointer :: sorted_child_list
-    type(Agrif_PGrid),     pointer :: child_p
-    type(Agrif_PGrid),     pointer :: g1p, g2p
-    type(Agrif_Proc_p),    pointer :: pp1, pp2
-    type(Agrif_Proc),      pointer :: proc
-    integer                        :: nb_seq_max, nb_seqs, cur_seq
-!
-    nb_seq_max = 0
-!
-    if ( grid % child_list % nitems == 0 ) return
-!
-! For each required proc...
-    pp1  => grid % required_proc_list % first
-    do while ( associated(pp1) )
-        proc => pp1 % proc
-        proc % nb_seqs = 0
-!   ..loop over all child grids...
-        child_p => grid % child_list % first
-        do while ( associated(child_p) )
-!       ..and look for 'proc' in the list of procs required by 'child'
-            pp2 => child_p % gr % required_proc_list % first
-            do while ( associated(pp2) )
-                if ( proc % pn == pp2 % proc % pn ) then
-!                   'proc' is required by this child grid, so we increment its number of sequences
-                    proc % nb_seqs = proc % nb_seqs + 1
-                    pp2 => NULL()
-                else
-                    pp2 => pp2 % next
-                endif
-            enddo
-            child_p => child_p % next
-        enddo
-        nb_seq_max = max(nb_seq_max, proc % nb_seqs)
-        pp1 => pp1 % next
-    enddo
-!
-! For each grid...
-    g1p => grid % child_list % first
-    do while ( associated(g1p) )
-!     compare it with the following ones
-        g2p => g1p % next
-        do while ( associated(g2p) )
-            if ( Agrif_seq_grids_are_connected( g1p % gr, g2p % gr ) ) then
-                call Agrif_gl_append( g1p % gr % neigh_list, g2p % gr )
-                call Agrif_gl_append( g2p % gr % neigh_list, g1p % gr )
-            endif
-            g2p => g2p % next
-        enddo
-        g1p => g1p % next
-    enddo
-!
-! Colorize graph nodes
-    nb_seqs = Agrif_seq_colorize_grid_list(grid % child_list)
-    sorted_child_list => Agrif_gl_merge_sort ( grid % child_list, compare_colors )
-!
-! Create sequence structure
-    cur_seq = 0
-    grid % child_seq => Agrif_seq_allocate_list(nb_seqs)
-    child_p => sorted_child_list % first
-    do while ( associated(child_p) )
-        if ( cur_seq /= child_p % gr % seq_num ) then
-            cur_seq = child_p % gr % seq_num
-        endif
-        call Agrif_seq_add_grid(grid % child_seq,cur_seq,child_p% gr)
-        child_p => child_p % next
-    enddo
-!
-    call Agrif_gl_delete(sorted_child_list)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_create_proc_sequences
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_seq_grids_are_connected( g1, g2 ) result( connection )
-!
-!< Compare required_proc_list for g1 and g2. These are connected if they share a same proc.
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(in) :: g1, g2
-!
-    logical :: connection
-    type(Agrif_Proc_p), pointer :: pp1, pp2
-!
-    connection = .false.
-!
-    pp1 => g1 % required_proc_list % first
-!
-    do while( associated(pp1) .and. (.not. connection) )
-!
-        pp2 => g2 % required_proc_list % first
-        do while ( associated(pp2) .and. (.not. connection) )
-            if ( pp1 % proc % pn == pp2 % proc % pn ) then
-            ! if pp1 and pp2 are the same proc, it means that g1 and g2 are connected. We stop here.
-                connection = .true.
-            endif
-            pp2 => pp2 % next
-        enddo
-        pp1 => pp1 % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end function Agrif_seq_grids_are_connected
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_seq_colorize_grid_list ( gridlist ) result ( ncolors )
-!
-!< 1.  Sort nodes in decreasing order of degree.
-!< 2.  Color the node with highest degree with color 1.
-!< 3.  Choose the node with the largest DSAT value. In case of conflict, choose the one with the
-!!       highest degree. Then the one corresponding to the largest grid.
-!< 4.  Color this node with the smallest possible color.
-!< 5.  If all nodes are colored, then stop. Otherwise, go to 3.
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(in)    :: gridlist
-!
-    type(Agrif_Grid_List),   pointer  :: X, Y
-    type(Agrif_PGrid),       pointer  :: gridp
-    type(Agrif_Grid_List),   pointer  :: tmp_gl
-    integer                           :: ncolors
-    integer, dimension(1:gridlist%nitems)   :: colors
-!
-! Be carefull...
-    nullify(Y)
-!
-! First initialize the color of each node
-    gridp => gridlist % first
-    do while ( associated(gridp) )
-        gridp % gr % seq_num = 0
-        gridp => gridp % next
-    enddo
-!
-! Then sort the grids by decreasing degree
-    X => Agrif_gl_merge_sort( gridlist, compare_grid_degrees )
-    gridp => X % first
-!
-! Colorize the first grid in the list
-    gridp % gr % seq_num = 1
-    gridp => gridp % next
-!
-! Then for each of its neighbors...
-    do while ( associated(gridp) )
-!
-        if ( gridp % gr % neigh_list % nitems == 0 ) then
-        ! this grid is alone... let.s attach it to an existing sequence
-            call Agrif_seq_attach_grid( X, gridp % gr )
-            gridp => gridp % next
-            cycle
-        endif
-!
-!     Compute dsat value of all non-colored grids
-        tmp_gl => Agrif_gl_build_from_gp(gridp)
-        call Agrif_seq_calc_dsat(tmp_gl)
-!
-!     Sort non-colored grids by decreasing dsat value, then by size
-        call Agrif_gl_delete(Y)
-        Y => Agrif_gl_merge_sort( tmp_gl, compare_dsat_values, compare_size_values )
-!
-!     Next coloration is for the first grid in this list  TODO : maybe we could find a better choice ..?
-        gridp => Y % first
-!
-!     Assign a color to the chosen grid
-        gridp % gr % seq_num = Agrif_seq_smallest_available_color_in_neighborhood( gridp % gr % neigh_list )
-!
-        gridp => gridp % next
-        call Agrif_gl_delete(tmp_gl)
-!
-    enddo
-!
-    call Agrif_gl_delete(X)
-    call Agrif_seq_colors_in_neighborhood( gridlist, colors )
-    ncolors = maxval(colors)
-!---------------------------------------------------------------------------------------------------
-end function Agrif_seq_colorize_grid_list
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_seq_attach_grid ( gridlist, grid )
-!
-!< 'grid' is not connected to any neighbor. Therefore, we give an existing and well chosen color.
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(in)       :: gridlist
-    type(Agrif_Grid),      intent(inout)    :: grid
-!
-    integer, dimension(gridlist%nitems) :: colors
-    integer, dimension(:), allocatable  :: ngrids_by_color
-    integer :: i, color, ncolors
-!
-    call Agrif_seq_colors_in_neighborhood( gridlist, colors )
-    ncolors = maxval(colors)
-!
-    allocate(ngrids_by_color(ncolors))
-    ngrids_by_color = 0
-!
-    do i = 1,gridlist % nitems
-        if (colors(i) > 0)  ngrids_by_color(colors(i)) = ngrids_by_color(colors(i)) + 1
-    enddo
-!
-    color = ncolors
-    do i = 1,ncolors
-        if ( ngrids_by_color(i) < color ) color = i
-    enddo
-!
-    grid % seq_num = color
-    deallocate(ngrids_by_color)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_attach_grid
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_seq_colors_in_neighborhood ( neigh_list, colors )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(in)   :: neigh_list
-    integer, dimension(:), intent(out)  :: colors
-!
-    integer                     :: i
-    type(Agrif_PGrid), pointer  :: gridp
-!
-    i = lbound(colors,1)
-    colors = 0
-    gridp => neigh_list % first
-!
-    do while ( associated(gridp) )
-!
-        if ( i > ubound(colors,1) ) then
-            print*,'Error in Agrif_seq_colors_in_neighborhood : "colors" array is too small'
-            stop
-        endif
-        colors(i) = gridp % gr % seq_num
-        gridp => gridp % next
-        i = i+1
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_colors_in_neighborhood
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_seq_smallest_available_color_in_neighborhood ( neigh_list ) result ( smallest )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(in)   :: neigh_list
-!
-    integer, dimension(:), allocatable :: color_is_met
-    integer     :: colors_tab(1:neigh_list%nitems)
-    integer     :: i, smallest, max_color
-!
-    call Agrif_seq_colors_in_neighborhood( neigh_list, colors_tab )
-    max_color = maxval(colors_tab)
-!
-    allocate(color_is_met(1:max_color))
-    color_is_met = 0
-!
-    do i = 1,neigh_list % nitems
-        if ( colors_tab(i) /= 0 ) then
-            color_is_met(colors_tab(i)) = 1
-        endif
-    enddo
-!
-    smallest = max_color+1
-    do i = 1,max_color
-        if ( color_is_met(i) == 0 ) then
-            smallest = i
-            exit
-        endif
-    enddo
-!
-    deallocate(color_is_met)
-!---------------------------------------------------------------------------------------------------
-end function Agrif_seq_smallest_available_color_in_neighborhood
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_seq_calc_dsat ( gridlist )
-!< For each node 'v' :
-!<   if none of its neighbors is colored then
-!<       DSAT(v) = degree(v)  #  degree(v) := number of neighbors
-!<   else
-!<       DSAT(v) = number of different colors used in the first neighborhood of v.
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(in)   :: gridlist
-!
-    type(Agrif_PGrid), pointer          :: gridp
-    type(Agrif_Grid),  pointer          :: grid
-    integer, dimension(:), allocatable  :: colors, color_is_met
-    integer                             :: i, ncolors
-!
-    gridp => gridlist % first
-!
-    do while ( associated(gridp) )
-!
-        grid => gridp % gr
-!
-        allocate(colors(grid % neigh_list % nitems))
-        call Agrif_seq_colors_in_neighborhood( grid % neigh_list, colors )
-
-        allocate(color_is_met(1:maxval(colors)))
-        color_is_met = 0
-!
-        do i = 1,grid % neigh_list % nitems
-            if ( colors(i) /= 0 ) then
-                color_is_met(colors(i)) = 1
-            endif
-        enddo
-        ncolors = sum(color_is_met)
-!
-        if ( ncolors == 0 ) then
-            grid % dsat = grid % neigh_list % nitems
-        else
-            grid % dsat = ncolors
-        endif
-        deallocate(colors, color_is_met)
-        gridp => gridp % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_calc_dsat
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_seq_allocate_procs_to_childs ( coarse_grid )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(inout) :: coarse_grid
-!
-    integer                         :: is, ip, ig, ngrids
-    type(Agrif_Grid_List), pointer  :: gridlist
-    type(Agrif_PGrid),     pointer  :: gp
-    type(Agrif_Grid),      pointer  :: grid
-    type(Agrif_Proc_List), pointer  :: proclist
-    type(Agrif_Proc),      pointer  :: proc
-    type(Agrif_Proc_p),    pointer  :: pp
-    type(Agrif_Proc), dimension(:), allocatable, target :: procarray
-    type(Agrif_Grid), dimension(:), allocatable         :: gridarray
-    type(Agrif_Sequence_List), pointer :: seqlist
-    real,dimension(:),allocatable :: grid_costs
-    integer,dimension(:), allocatable :: nbprocs_per_grid
-    integer :: i1, i2, j1, j2
-    real :: max_cost
-    integer :: max_index
-!
-    seqlist => coarse_grid % child_seq
-    if ( .not. associated(seqlist) ) return
-!
-! Initialize proc allocation
-    pp => coarse_grid % proc_def_list % first
-    do while ( associated(pp) )
-        pp % proc % grid_id = 0
-        pp => pp % next
-    enddo
-!
-! For each sequence...
-    do is = 1,seqlist % nb_seqs
-!
-        proclist => seqlist % sequences(is) % proclist
-        gridlist => seqlist % sequences(is) % gridlist
-!
-!     Copy coarse grid proc list and convert it to an array
-        call Agrif_pl_deep_copy( coarse_grid % proc_def_list, proclist )
-        call Agrif_pl_to_array ( proclist, procarray )
-!
-!     Allocate a temporary array with concerned grid numbers
-        ngrids = gridlist % nitems
-        allocate(gridarray(1:ngrids))
-        allocate(grid_costs(1:ngrids))
-        allocate(nbprocs_per_grid(1:ngrids))
-
-      nbprocs_per_grid = 0
-!
-!     Allocate required procs to each grid
-        gp => gridlist % first
-        ig = 0
-        do while ( associated(gp) )
-            grid => gp % gr
-            ig = ig+1 ; gridarray(ig) = grid
-            pp => grid % required_proc_list % first
-            do while ( associated(pp) )
-                procarray( pp % proc % pn+1 ) % grid_id = grid % fixedrank
-                nbprocs_per_grid(ig) = nbprocs_per_grid(ig) + 1
-                pp => pp % next
-            enddo
-            gp => gp % next
-        enddo
-!
-!     Add unused procs to the grids
-! TODO FIXME: This is just a dummy allocation. You should take into account grid size and more
-!             information here...
-
-! Estimate current costs
-
-        do ig = 1, ngrids
-          i1 = gridarray(ig)%ix(1)
-          i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1
-          j1 = gridarray(ig)%ix(2)
-          j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1
-          Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig))
-          grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1)
-        enddo
-
-        ig = 1
-        do ip = 1,proclist%nitems
-            if ( procarray( ip ) % grid_id == 0 ) then
-!             this proc is unused
-              max_cost = 0.
-              max_index = 1
-              do ig = 1,ngrids
-                 if (grid_costs(ig) > max_cost) then
-                    max_cost = grid_costs(ig)
-                    max_index = ig
-                 endif
-              enddo
-
-              ig = max_index
-              procarray( ip ) % grid_id = gridarray(ig) % fixedrank
-
-              nbprocs_per_grid(ig) =  nbprocs_per_grid(ig) + 1
-              i1 = gridarray(ig)%ix(1)
-              i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1
-              j1 = gridarray(ig)%ix(2)
-              j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1
-              Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig))
-              grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1)
-
-            endif
-        enddo
-!
-!     Allocate proc nums to each grid
-        gp => gridlist % first
-        do while ( associated(gp) )
-            do ip = 1,proclist%nitems
-                if ( procarray( ip ) % grid_id == gp % gr % fixedrank ) then
-                    allocate(proc)
-                    proc = procarray( ip )
-                    call Agrif_pl_append(gp % gr % proc_def_in_parent_list, proc)
-                endif
-            enddo
-            gp => gp % next
-        enddo
-!
-!     Clean up
-        deallocate(procarray, gridarray, grid_costs, nbprocs_per_grid)
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_allocate_procs_to_childs
-!===================================================================================================
-!
-!===================================================================================================
-subroutine Agrif_seq_create_communicators ( grid )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), intent(inout) :: grid
-!
-    include 'mpif.h'
-    type(Agrif_Sequence_List), pointer  :: seqlist  ! List of child sequences
-    type(Agrif_PGrid), pointer          :: gridp
-    type(Agrif_Proc),  pointer          :: proc
-    integer     :: i, ierr
-    integer     :: current_comm, comm_seq, color_seq
-!
-    seqlist => grid % child_seq
-    if ( .not. associated(seqlist) ) return
-!
-    current_comm = grid % communicator
-    color_seq = MPI_COMM_NULL
-!
-! For each sequence, split the current communicator into as many groups as needed.
-    do i = 1,seqlist % nb_seqs
-!
-!     Loop over each proclist to give a color to the current process
-        gridp => seqlist % sequences(i) % gridlist % first
-        grid_loop : do while ( associated(gridp) )
-            proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank )
-            if ( associated(proc) ) then
-                if ( gridp % gr % fixedrank /= proc % grid_id ) then
-                    write(*,'("### Error Agrif_seq_create_communicators : ")')
-                    write(*,'("  inconsitancy on proc ",i2,":")') Agrif_Procrank
-                    write(*,'("gr % fixedrank = ",i0,", where proc % grid_id = ",i0)') &
-                            gridp % gr % fixedrank, proc % grid_id
-                    stop
-                endif
-                color_seq = gridp % gr % fixedrank
-                exit grid_loop
-            endif
-            gridp => gridp % next
-        enddo grid_loop
-!
-        call MPI_COMM_SPLIT(current_comm, color_seq, Agrif_ProcRank, comm_seq, ierr)
-        gridp % gr % communicator = comm_seq
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_seq_create_communicators
-!===================================================================================================
-!
-!===================================================================================================
-function Agrif_seq_select_child ( g, is ) result ( gridp )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer, intent(in)   :: g
-    integer,                   intent(in)   :: is
-!
-    type(Agrif_PGrid), pointer  :: gridp
-    type(Agrif_Proc),  pointer  :: proc
-!
-    call Agrif_Instance( g )
-    gridp => g % child_seq % sequences(is) % gridlist % first
-!
-    do while ( associated(gridp) )
-        proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank )
-        if ( associated(proc) ) then
-            return
-        endif
-        gridp => gridp % next
-    enddo
-    write(*,'("### Error Agrif_seq_select_child : no grid found in sequence ",i0," (mother G",i0,") for P",i0)')&
-        is, g%fixedrank, Agrif_Procrank
-    stop
-!---------------------------------------------------------------------------------------------------
-end function Agrif_seq_select_child
-!===================================================================================================
-#else
-    subroutine dummy_Agrif_seq ()
-    end subroutine dummy_Agrif_seq
-#endif
-!
-end module Agrif_seq
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 10251)
@@ -0,0 +1,460 @@
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_types  
+C
+      Module Agrif_types 
+C
+CCC   Description:
+CCC   Definition of data types used in Agrif, of several variables and
+C        PARAMETERs.     
+C
+      IMPLICIT NONE
+      
+C     Maximum refinement ratio
+
+      INTEGER, PARAMETER :: Agrif_MaxRaff = 7
+      
+C     Maximum number of grids of the hierarchy
+      INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10
+C     MPI Communicator
+      INTEGER :: MPI_COMM_AGRIF
+C
+C     **************************************************************************
+CCC   TYPE Agrif_LRECTANGLE
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE allowing a grid to reach a grid on the same level or its child
+CCC   grids.
+C
+      TYPE Agrif_lrectangle  
+           TYPE(Agrif_rectangle) , Pointer :: r    ! to reach a child grid
+           TYPE(Agrif_lrectangle), Pointer :: next ! to reach a grid on the 
+                                                   !    same level
+      End TYPE Agrif_lrectangle  
+C
+C     **************************************************************************
+CCC   TYPE Agrif_RECTANGLE: 
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define several CHARACTERistics of a grid (number,position,
+CCC   time and space refinement factors,...). 
+C
+      TYPE Agrif_rectangle
+           INTEGER                         :: number      ! Number of the grid
+           ! Number of child grids 
+           INTEGER                         :: nbgridchild 
+           ! Minimal position in the x,y and z direction
+           INTEGER, DIMENSION(3)           :: imin        
+           ! Maximal position in the x,y and z direction 
+           INTEGER, DIMENSION(3)           :: imax 
+           ! Space refinement factor in the x,y and z direction  
+           INTEGER, DIMENSION(3)           :: spaceref    
+           ! Time refinement factor in the x,y and z direction
+           INTEGER, DIMENSION(3)           :: timeref     
+           ! Pointer to reach a grid on  the same level or a child grid
+           TYPE(Agrif_lrectangle), Pointer :: childgrids  
+      End TYPE Agrif_rectangle  
+C
+C
+C
+C     **************************************************************************
+CCC   TYPE Agrif_PGrid
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to go over the grid hierarchy (used for the creation of this 
+CCC   grid hierarchy and during the time integration).
+C 
+      TYPE Agrif_pgrid  
+           ! allows to reach a child grid  
+           TYPE(Agrif_grid) , Pointer :: gr
+           ! allows to reach the grids of the same level 
+           TYPE(Agrif_pgrid), Pointer :: next 
+      End TYPE Agrif_pgrid 
+C
+C
+C
+C     **************************************************************************
+CCC   TYPE Agrif_PVariable
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define a grid variable.
+C
+      TYPE Agrif_PVariable 
+           ! This field allows to get the various CHARACTERistics 
+           !   of the variable (defined by the Agrif_Variable data TYPE)
+           TYPE(Agrif_Variable) , Pointer :: var  
+           ! Pointer on the parent grid
+           TYPE(Agrif_PVariable), Pointer :: parent_var 
+      End TYPE Agrif_PVariable 
+C
+C     **************************************************************************
+CCC   TYPE Agrif_Grid
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define a grid (position, space and time refinement factors).
+C
+      TYPE Agrif_grid  
+           ! pointer on the parent grid 
+           TYPE(Agrif_grid)                    ,Pointer :: parent      
+           ! pointer on the child grids 
+           TYPE(Agrif_pgrid)                   ,Pointer :: child_grids 
+           ! List of the grid variables   
+           TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: tabvars     
+           ! pointer on the save grid 
+           TYPE(Agrif_grid)                    ,Pointer :: save_grid                
+C
+           ! Global x,y and z position
+           REAL    ,DIMENSION(3)                   :: Agrif_x   
+           ! Global space step in the x,y and z direction
+           REAL    ,DIMENSION(3)                   :: Agrif_d
+           ! number of cells in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: nb        
+           ! minimal position in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: ix        
+           ! Space refinement factor in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: spaceref  
+           ! Time refinement factor in the x,y and z direction 
+           INTEGER ,DIMENSION(3)                   :: timeref   
+           INTEGER ,DIMENSION(:)          ,Pointer :: restore1D   
+           INTEGER ,DIMENSION(:,:)        ,Pointer :: restore2D   
+           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: restore3D 
+           INTEGER ,DIMENSION(:,:,:,:)    ,Pointer :: restore4D
+           INTEGER ,DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D
+           INTEGER ,DIMENSION(:,:,:,:,:,:),Pointer :: restore6D
+           ! number of time step  
+           INTEGER                                 :: ngridstep 
+           INTEGER                                 :: rank  
+           !moving grid id
+           INTEGER                                 :: grid_id
+           ! number of the grid 
+           INTEGER                                 :: fixedrank 
+           ! fixed or moving grid ?  
+           LOGICAL                                 :: fixed     
+           LOGICAL                                 :: oldgrid   
+C          LOGICALs indicating if the current grid has a common border 
+C             with the root coarse grid
+           LOGICAL ,DIMENSION(3)                   :: NearRootBorder
+           LOGICAL ,DIMENSION(3)                   :: DistantRootBorder
+C          Arrays for adaptive grid refinement
+           REAL    ,DIMENSION(:)          ,Pointer :: valtabpoint1D
+           REAL    ,DIMENSION(:,:)        ,Pointer :: valtabpoint2D
+           REAL    ,DIMENSION(:,:,:)      ,Pointer :: valtabpoint3D
+           INTEGER ,DIMENSION(:)          ,Pointer :: tabpoint1D
+           INTEGER ,DIMENSION(:,:)        ,Pointer :: tabpoint2D
+           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: tabpoint3D
+           Type(Agrif_List_Variables), Pointer     :: variables=>NULL()
+           INTEGER                                 :: NbVariables = 0
+           Type(Agrif_Flux), Pointer               :: fluxes => NULL()
+           INTEGER                                 :: level
+           ! level of the grid in the hierarchy
+      End TYPE Agrif_grid
+C
+C     **************************************************************************
+CCC   TYPE Agrif_VARIABLE
+C     **************************************************************************
+C     
+CCC   Description:
+CCC   Data TYPE to CHARACTERize a grid variable.   
+C
+      TYPE Agrif_Variable 
+         CHARACTER*80 :: variablename
+C       
+         ! Pointer on the variable of the root grid 
+         TYPE(Agrif_Variable), Pointer :: root_var 
+C
+         ! index of the first point in the REAL domain (x,y and z direction)
+         INTEGER     ,DIMENSION(6)          :: point
+         ! position of the variable on the cell (1 for the boarder of 
+         !    the edge, 2 for the center)
+         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
+         ! Indication for the space interpolation (module Agrif_Boundary)
+         INTEGER                   ,Pointer :: interpIndex => NULL() 
+         ! number of DIMENSIONs of the grid variable
+         INTEGER                            :: nbdim = 0             
+         ! Array indicating the TYPE of DIMENSION (space or not) for 
+         !    each of them 
+         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
+C        Arrays containing the values of the grid variables (REAL)
+         REAL                                    :: array0 
+         REAL   , DIMENSION(:)          ,ALLOCATABLE :: array1    
+         REAL   , DIMENSION(:,:)        ,ALLOCATABLE :: array2    
+         REAL   , DIMENSION(:,:,:)      ,ALLOCATABLE :: array3    
+         REAL   , DIMENSION(:,:,:,:)    ,ALLOCATABLE :: array4    
+         REAL   , DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: array5    
+         REAL   , DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: array6  
+         
+         REAL   , DIMENSION(:)          ,POINTER :: parray1    
+         REAL   , DIMENSION(:,:)        ,POINTER :: parray2    
+         REAL   , DIMENSION(:,:,:)      ,POINTER :: parray3    
+         REAL   , DIMENSION(:,:,:,:)    ,POINTER :: parray4    
+         REAL   , DIMENSION(:,:,:,:,:)  ,POINTER :: parray5    
+         REAL   , DIMENSION(:,:,:,:,:,:),POINTER :: parray6
+         
+C        Arrays containing the values of the grid variables (REAL*8)
+         REAL*8                                 :: darray0
+         REAL*8, DIMENSION(:)          ,ALLOCATABLE :: darray1   
+         REAL*8, DIMENSION(:,:)        ,ALLOCATABLE :: darray2   
+         REAL*8, DIMENSION(:,:,:)      ,ALLOCATABLE :: darray3   
+         REAL*8, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: darray4   
+         REAL*8, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: darray5   
+         REAL*8, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: darray6   
+C        Arrays containing the values of the grid variables (REAL*4)
+         REAL*4                                 :: sarray0
+         REAL*4, DIMENSION(:)          ,ALLOCATABLE :: sarray1   
+         REAL*4, DIMENSION(:,:)        ,ALLOCATABLE :: sarray2   
+         REAL*4, DIMENSION(:,:,:)      ,ALLOCATABLE :: sarray3   
+         REAL*4, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: sarray4   
+         REAL*4, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: sarray5   
+         REAL*4, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: sarray6   
+C        Arrays containing the values of the grid variables (LOGICAL)
+         LOGICAL                                 :: larray0
+         LOGICAL, DIMENSION(:)          ,ALLOCATABLE :: larray1   
+         LOGICAL, DIMENSION(:,:)        ,ALLOCATABLE :: larray2   
+         LOGICAL, DIMENSION(:,:,:)      ,ALLOCATABLE :: larray3   
+         LOGICAL, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: larray4   
+         LOGICAL, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: larray5   
+         LOGICAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: larray6   
+C         Arrays containing the values of the grid variables (INTEGER)   
+         INTEGER                                 :: iarray0
+         INTEGER, DIMENSION(:)          ,ALLOCATABLE :: iarray1   
+         INTEGER, DIMENSION(:,:)        ,ALLOCATABLE :: iarray2   
+         INTEGER, DIMENSION(:,:,:)      ,ALLOCATABLE :: iarray3   
+         INTEGER, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: iarray4   
+         INTEGER, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: iarray5   
+         INTEGER, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: iarray6   
+C
+         INTEGER, DIMENSION(:)          ,Pointer :: restore1D => NULL()
+         INTEGER, DIMENSION(:,:)        ,Pointer :: restore2D => NULL()
+         INTEGER, DIMENSION(:,:,:)      ,Pointer :: restore3D => NULL()
+         INTEGER, DIMENSION(:,:,:,:)    ,Pointer :: restore4D => NULL()
+         INTEGER, DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D => NULL()
+         INTEGER, DIMENSION(:,:,:,:,:,:),Pointer :: restore6D => NULL()
+C   
+         CHARACTER(2050)                          :: carray0
+         CHARACTER(200), DIMENSION(:)    ,ALLOCATABLE :: carray1
+         CHARACTER(200), DIMENSION(:,:)  ,ALLOCATABLE :: carray2
+C
+         ! Array used for the time interpolation
+         REAL   , DIMENSION(:,:)      ,Pointer :: oldvalues2D => NULL()
+
+         ! if the variable should be restore -> =1
+         LOGICAL :: restaure = .FALSE.
+         ! the interpolation should be made in any case
+         LOGICAL :: Interpolationshouldbemade = .FALSE. 
+         INTEGER :: bcinf ! option bc
+         INTEGER :: bcsup ! option bc
+         INTEGER, DIMENSION(6) :: updateinf ! option update
+         INTEGER, DIMENSION(6) :: updatesup ! option update         
+         INTEGER, DIMENSION(6,6) :: bcTYPEinterp ! option bcinterp
+         INTEGER, DIMENSION(6) :: TYPEinterp ! option interp
+         INTEGER, DIMENSION(6) :: TYPEupdate ! option update
+         
+         INTEGER, DIMENSION(6) :: lb, ub
+         
+         Type(Agrif_List_Interp_Loc), Pointer :: list_interp => NULL()
+         Type(Agrif_List_Interp_Loc), Pointer :: list_update => NULL()
+C
+      End TYPE Agrif_Variable 
+      
+      Type Agrif_Interp_Loc
+      integer,dimension(6) :: pttab,petab,
+     &                          pttab_Child,pttab_Parent = -99
+      integer,dimension(6) :: indmin, indmax
+      INTEGER,DIMENSION(6)    :: pttruetab,cetruetab
+      logical :: member, memberin      
+#if !defined key_mpp_mpi      
+      integer,dimension(6) :: indminglob,indmaxglob
+#else
+      integer,dimension(6) :: indminglob2,indmaxglob2
+      INTEGER,DIMENSION(6,2,2) :: parentarray
+      INTEGER,DIMENSION(:,:,:), POINTER :: tab4t
+      LOGICAL, DIMENSION(:), POINTER :: memberinall
+      INTEGER,DIMENSION(:,:,:), POINTER :: tab5t
+      LOGICAL, DIMENSION(:), POINTER :: memberinall2
+      LOGICAL, DIMENSION(:), POINTER :: sendtoproc1    
+      LOGICAL, DIMENSION(:), POINTER :: recvfromproc1      
+      LOGICAL, DIMENSION(:), POINTER :: sendtoproc2      
+      LOGICAL, DIMENSION(:), POINTER :: recvfromproc2      
+#endif      
+      End Type Agrif_Interp_Loc
+      
+      Type Agrif_List_Interp_Loc
+      Type(Agrif_Interp_Loc), Pointer :: interp_loc
+      Type(Agrif_List_Interp_Loc), Pointer :: suiv
+      End Type Agrif_List_Interp_Loc
+
+       TYPE Agrif_List_Variables
+         Type(Agrif_PVariable), Pointer :: pvar
+         Type(Agrif_List_Variables), Pointer :: nextvariable  => NULL()
+       END TYPE Agrif_List_Variables
+               
+       TYPE Agrif_Profile
+          character*80 :: profilename
+C
+         ! index of the first point in the REAL domain (x,y and z direction)
+         INTEGER     ,DIMENSION(6)          :: point
+         ! position of the variable on the cell (1 for the boarder of 
+         !    the edge, 2 for the center)
+         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
+         ! Indication for the space interpolation (module Agrif_Boundary)
+         INTEGER                   ,Pointer :: interpIndex => NULL() 
+         ! number of DIMENSIONs of the grid variable
+         INTEGER                            :: nbdim = 0             
+         ! Array indicating the TYPE of DIMENSION (space or not) for 
+         !    each of them 
+         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
+         Type(Agrif_Variable), Pointer :: var
+         Type(Agrif_Profile), Pointer :: nextprofile  => NULL()
+       END TYPE Agrif_Profile
+       
+       Type(Agrif_Profile), Pointer :: Agrif_MyProfiles => NULL()
+           
+C  Boundaries Fluxes
+
+      Type Agrif_Flux
+        Character*80 fluxname
+        Type(Agrif_Variable), Pointer :: fluxtabx
+        Type(Agrif_Variable), Pointer :: fluxtaby
+        Type(Agrif_Variable), Pointer :: fluxtabz        
+        Type(Agrif_Profile), Pointer  :: profile
+        Logical :: Fluxallocated = .FALSE.
+        Type(Agrif_Flux), Pointer     :: nextflux => NULL()
+      End Type Agrif_Flux      
+C
+C     **************************************************************************
+CCC   Different PARAMETERs
+C     **************************************************************************
+      TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: Agrif_tabvars
+C
+      ! this pointer always points on the root grid of the grid hierarchy
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_Mygrid      
+      ! Pointer used in the Agrif_regrid subroutine (Agrif_Util module). 
+      !    It contains  the safeguard of the grid hierarchy.
+      TYPE(Agrif_pgrid) ,Pointer :: Agrif_oldmygrid   
+      ! pointer to the current grid (the link is done by using the
+      !    Agrif_Instance   procedure (module Agrif_Init)) 
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_Curgrid
+      ! Pointer used in the Agrif_ChildGrid_to_ParentGrid and 
+      !    Agrif_ParentGrid_to_ChildGrid subroutines 
+      !    (Agrif_CurgridFunctions module). It contains the 
+      !    safeguard of the current grid hierarchy.
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_saveCURGRID
+C
+      ! Problem DIMENSION
+      INTEGER               :: Agrif_Probdim
+      ! number of variables
+      INTEGER               :: Agrif_NbVariables
+      ! number of fixed grids in the grid hierarchy
+      INTEGER               :: Agrif_nbfixedgrids            
+      ! space refinement factor
+      INTEGER ,DIMENSION(3) :: Agrif_coeffref
+      ! time refinement factor
+      INTEGER ,DIMENSION(3) :: Agrif_coeffreft
+      ! LOGICAL to use special values on the parent grid
+      LOGICAL               :: Agrif_UseSpecialValue
+      ! LOGICAL to use special values on the parent grid
+      LOGICAL               :: Agrif_UseSpecialValueInUpdate
+      ! LOGICAL to use special values on the current grid
+      LOGICAL               :: Agrif_UseSpecialValueFineGrid
+      ! Special values on the parent grid
+      REAL                  :: Agrif_SpecialValue
+      ! Special values on the current grid
+      REAL                  :: Agrif_SpecialValueFineGrid
+C   clustering PARAMETERs
+      INTEGER               :: Agrif_Regridding = 10
+      INTEGER               :: Agrif_Minwidth
+      REAL                  :: Agrif_Efficiency = 0.7
+      INTEGER               :: MaxSearch = 5
+      REAL    ,DIMENSION(3) :: Agrif_mind
+C     PARAMETERs for the interpolation of the child grids
+      ! linear interpolation
+      INTEGER ,PARAMETER    :: Agrif_linear=1
+      ! lagrange interpolation
+      INTEGER ,PARAMETER    :: Agrif_lagrange=2
+      ! spline interpolation
+      INTEGER ,PARAMETER    :: Agrif_eno=3
+      ! user s interpolation
+      INTEGER ,PARAMETER    :: Agrif_user_interp=4
+      ! constant interpolation
+      INTEGER ,PARAMETER    :: Agrif_constant=5
+      ! linear conservative interpolation 
+      INTEGER ,PARAMETER    :: Agrif_linearconserv=6
+      ! linear conservative interpolation       
+      INTEGER ,PARAMETER    :: Agrif_linearconservlim=7
+      INTEGER ,PARAMETER    :: Agrif_ppm=8 
+      INTEGER ,PARAMETER    :: Agrif_weno=9         
+C     PARAMETERs for the update of the parent grids      
+      INTEGER ,PARAMETER    :: Agrif_Update_Copy=1           ! copy
+      INTEGER ,PARAMETER    :: Agrif_Update_Average=2        ! average
+      INTEGER ,PARAMETER    :: Agrif_Update_Full_Weighting=3 ! full-weighting 
+C     Raffinement grid switch definition
+      ! Agrif_USE_ONLY_FIXED_GRIDS =1 if fixed grid mode
+      INTEGER               :: Agrif_USE_ONLY_FIXED_GRIDS    
+      ! Agrif_USE_FIXED_GRIDS = 1 if AMR mode + fixed grid 
+      !    else only AMR mode
+      INTEGER               :: Agrif_USE_FIXED_GRIDS
+      INTEGER               :: Agrif_Maxlevelloc
+C
+#ifdef key_mpp_mpi
+      INTEGER :: Agrif_Nbprocs  ! Number of processors
+      INTEGER :: Agrif_ProcRank ! Rank of the current processor 
+      INTEGER :: Agrif_Group    ! Group associated to MPI_COMM_AGRIF
+      INTEGER :: Agrif_MPIPREC
+#endif
+C
+      contains
+C   
+      Integer Function agrif_ceiling(x)
+C             
+          Real :: x
+          Integer ::i 
+C
+          i = floor(x)
+C      
+          if( abs(x - i).le.0.0001 )then
+             agrif_ceiling = i
+          else
+             agrif_ceiling = i+1
+          endif      
+C
+      End Function
+C
+      Integer Function agrif_int(x)
+C             
+          Real :: x
+          Integer ::i 
+C
+          i = floor(x) + 1
+C      
+          if( abs(x - i).le.0.0001 )then
+             agrif_int = i
+          else
+             agrif_int = i-1
+          endif      
+C
+      End Function
+      End Module Agrif_TYPEs  
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 10250)
+++ 	(revision )
@@ -1,425 +1,0 @@
-!     Agrif (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!
-!
-!> Definition of data types used in AGRIF, of several variables and parameters
-!
-module Agrif_Types
-!
-use Agrif_Procs
-!
-implicit none
-!
-integer, parameter :: Agrif_MaxRaff = 7       !< Maximum refinement ratio
-integer, parameter :: Agrif_NbMaxGrids = 10   !< Maximum number of grids of the hierarchy
-!
-!===================================================================================================
-type Agrif_LRectangle
-!---------------------------------------------------------------------------------------------------
-!<  Data type allowing a grid to reach a grid on the same level or its child grids
-!
-    type(Agrif_Rectangle) , pointer :: r    => NULL()   !< to reach a child grid
-    type(Agrif_LRectangle), pointer :: next => NULL()   !< to reach a grid on the same level
-!
-!---------------------------------------------------------------------------------------------------
-end type Agrif_LRectangle
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Rectangle
-!---------------------------------------------------------------------------------------------------
-!<  Data type to define several characteristics of a grid (number, position, time and space
-!<  refinement factors, etc).
-!
-    integer                         :: number       !< Number of the grid
-    integer, dimension(3)           :: imin         !< Minimal position in the x,y and z direction
-    integer, dimension(3)           :: imax         !< Maximal position in the x,y and z direction
-    integer, dimension(3)           :: spaceref     !< Space refinement factor in the x,y and z direction
-    integer, dimension(3)           :: timeref      !< Time refinement factor in the x,y and z direction
-    type(Agrif_LRectangle), pointer :: childgrids => NULL()   !< Pointer to reach a grid on the same level or a child grid
-!
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Rectangle
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Variable
-!---------------------------------------------------------------------------------------------------
-!<  Data type to characterize a grid variable.
-!
-    type(Agrif_Variable), pointer  :: root_var   => NULL()  !< pointer on the variable of the root grid
-    type(Agrif_Variable), pointer  :: parent_var => NULL()  !< pointer on the parent variable
-!
-    integer,   dimension(6)              :: point           !< index of the first point in the
-                                                            !<    real domain (x,y and z direction)
-    integer,   dimension(:), allocatable :: posvar          !< position of the variable on the cell
-                                                            !<   (1 for the boarder of the edge, 2 for the center)
-    integer                            :: interpIndex = -1  !< Indication for the space interpolation (module Agrif_Boundary)
-    integer                            :: nbdim = 0         !< number of dimensions of the grid variable
-    character(1), dimension(:), allocatable :: interptab    !< Array indicating the type of dimension (space or not)
-                                                            !!   for each of them
-    integer,   dimension(:), allocatable :: coords          !< Array indicating the coordinate for each dimension
-                                                            !!   of the array that is refined :
-                                                            !!  'x' -> 1 ; 'y' -> 2 ; 'z' -> 3 ; 'N' -> 0
-
-!> @}
-!> \name Arrays containing the values of the grid variables (real)
-!> @{
-    real,    dimension(:)          , allocatable :: array1
-    real,    dimension(:,:)        , allocatable :: array2
-    real,    dimension(:,:,:)      , allocatable :: array3
-    real,    dimension(:,:,:,:)    , allocatable :: array4
-    real,    dimension(:,:,:,:,:)  , allocatable :: array5
-    real,    dimension(:,:,:,:,:,:), allocatable :: array6
-!> @}
-!> \name Arrays containing the values of the grid variables (real*8)
-!> @{
-    real(8), dimension(:)          , allocatable :: darray1
-    real(8), dimension(:,:)        , allocatable :: darray2
-    real(8), dimension(:,:,:)      , allocatable :: darray3
-    real(8), dimension(:,:,:,:)    , allocatable :: darray4
-    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
-    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
-!> @}
-!> \name Arrays containing the values of the grid variables (real*4)
-!> @{
-    real(4), dimension(:)          , allocatable :: sarray1
-    real(4), dimension(:,:)        , allocatable :: sarray2
-    real(4), dimension(:,:,:)      , allocatable :: sarray3
-    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
-    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
-    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
-!> @}
-!> \name Arrays used to restore the values
-!> @{
-    integer, dimension(:)          , pointer :: restore1D => NULL()
-    integer, dimension(:,:)        , pointer :: restore2D => NULL()
-    integer, dimension(:,:,:)      , pointer :: restore3D => NULL()
-    integer, dimension(:,:,:,:)    , pointer :: restore4D => NULL()
-    integer, dimension(:,:,:,:,:)  , pointer :: restore5D => NULL()
-    integer, dimension(:,:,:,:,:,:), pointer :: restore6D => NULL()
-!> @}
-
-    real, dimension(:,:), pointer :: oldvalues2D => NULL() !< Array used for the time interpolation
-
-    logical :: restore = .FALSE. !< =1 if the variable should be restored
-    logical :: Interpolationshouldbemade = .FALSE. !< TRUE if the interpolation should be made in any case
-    integer                 :: bcinf !< option bc
-    integer                 :: bcsup !< option bc
-    integer, dimension(6)   :: type_interp    !< option interp
-    integer, dimension(6,6) :: type_interp_bc !< option bcinterp
-    integer, dimension(6)   :: type_update    !< option update
-
-    integer, dimension(6)   :: lb
-    integer, dimension(6)   :: ub
-
-    logical,dimension(6,2) :: memberin
-    integer,dimension(6,2,2,6,2) :: childarray
-
-    type(Agrif_List_Interp_Loc), pointer :: list_interp => NULL()
-    type(Agrif_List_Interp_Loc), pointer :: list_update => NULL()
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Variable
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Variable_c
-!---------------------------------------------------------------------------------------------------
-!<  Data type to characterize a grid variable.
-!
-    type(Agrif_Variable_c), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
-    type(Agrif_Variable_c), pointer  :: parent_var => NULL()      !< pointer on the parent variable
-!
-    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
-!
-!> \name Arrays containing the values of the grid variables (character)
-!> @{
-    character(2400)                             :: carray0
-    character(200), dimension(:)  , allocatable :: carray1
-    character(200), dimension(:,:), allocatable :: carray2
-!> @}
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Variable_c
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Variable_r
-!---------------------------------------------------------------------------------------------------
-!<  Data type to characterize a grid variable.
-!
-    type(Agrif_Variable_r), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
-    type(Agrif_Variable_r), pointer  :: parent_var => NULL()      !< pointer on the parent variable
-!
-    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
-!
-!> \name Arrays containing the values of the grid variables (real)
-!> @{
-    real                                         :: array0
-    real,    dimension(:)          , allocatable :: array1
-    real,    dimension(:,:)        , allocatable :: array2
-    real,    dimension(:,:,:)      , allocatable :: array3
-    real,    dimension(:,:,:,:)    , allocatable :: array4
-    real,    dimension(:,:,:,:,:)  , allocatable :: array5
-    real,    dimension(:,:,:,:,:,:), allocatable :: array6
-!> @}
-!> \name Arrays containing the values of the grid variables (real*8)
-!> @{
-    real(8)                                      :: darray0
-    real(8), dimension(:)          , allocatable :: darray1
-    real(8), dimension(:,:)        , allocatable :: darray2
-    real(8), dimension(:,:,:)      , allocatable :: darray3
-    real(8), dimension(:,:,:,:)    , allocatable :: darray4
-    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
-    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
-!> @}
-!> \name Arrays containing the values of the grid variables (real*4)
-!> @{
-    real(4)                                      :: sarray0
-    real(4), dimension(:)          , allocatable :: sarray1
-    real(4), dimension(:,:)        , allocatable :: sarray2
-    real(4), dimension(:,:,:)      , allocatable :: sarray3
-    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
-    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
-    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
-!> @}
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Variable_r
-!===================================================================================================
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Variable_l
-!---------------------------------------------------------------------------------------------------
-!<  Data type to characterize a grid variable.
-!
-    type(Agrif_Variable_l), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
-    type(Agrif_Variable_l), pointer  :: parent_var => NULL()      !< pointer on the parent variable
-!
-    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
-!
-!> \name Arrays containing the values of the grid variables (logical)
-!> @{
-    logical                                      :: larray0
-    logical, dimension(:)          , allocatable :: larray1
-    logical, dimension(:,:)        , allocatable :: larray2
-    logical, dimension(:,:,:)      , allocatable :: larray3
-    logical, dimension(:,:,:,:)    , allocatable :: larray4
-    logical, dimension(:,:,:,:,:)  , allocatable :: larray5
-    logical, dimension(:,:,:,:,:,:), allocatable :: larray6
-!> @}
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Variable_l
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Variable_i
-!---------------------------------------------------------------------------------------------------
-!<  Data type to characterize a grid variable.
-!
-    type(Agrif_Variable_i), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
-    type(Agrif_Variable_i), pointer  :: parent_var => NULL()      !< pointer on the parent variable
-!
-    integer                          :: nbdim = 0             !< number of dimensions of the grid variable
-!
-!> \name Arrays containing the values of the grid variables (integer)
-!> @{
-    integer                                      :: iarray0
-    integer, dimension(:)          , allocatable :: iarray1
-    integer, dimension(:,:)        , allocatable :: iarray2
-    integer, dimension(:,:,:)      , allocatable :: iarray3
-    integer, dimension(:,:,:,:)    , allocatable :: iarray4
-    integer, dimension(:,:,:,:,:)  , allocatable :: iarray5
-    integer, dimension(:,:,:,:,:,:), allocatable :: iarray6
-!> @}
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Variable_i
-!===================================================================================================
-!
-!===================================================================================================
-type Agrif_Interp_Loc
-!---------------------------------------------------------------------------------------------------
-    integer,dimension(6)              :: pttab, petab, pttab_Child, pttab_Parent = -99
-    integer,dimension(6)              :: indmin, indmax
-    integer,dimension(6)              :: pttruetab,cetruetab
-    logical :: member, memberin
-#if !defined AGRIF_MPI
-    integer,dimension(6)              :: indminglob,indmaxglob
-#else
-    integer,dimension(6)              :: indminglob2,indmaxglob2
-    integer,dimension(6,2,2)          :: parentarray
-    integer,dimension(:,:,:), pointer :: tab4t          => NULL()
-    integer,dimension(:,:,:), pointer :: tab5t          => NULL()
-    logical, dimension(:),    pointer :: memberinall    => NULL()
-    logical, dimension(:),    pointer :: memberinall2   => NULL()
-    logical, dimension(:),    pointer :: sendtoproc1    => NULL()
-    logical, dimension(:),    pointer :: sendtoproc2    => NULL()
-    logical, dimension(:),    pointer :: recvfromproc1  => NULL()
-    logical, dimension(:),    pointer :: recvfromproc2  => NULL()
-#endif
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Interp_Loc
-!===================================================================================================
-
-!===================================================================================================
-type Agrif_List_Interp_Loc
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Interp_Loc),      pointer :: interp_loc => NULL()
-    type(Agrif_List_Interp_Loc), pointer :: suiv       => NULL()
-!---------------------------------------------------------------------------------------------------
-end type Agrif_List_Interp_Loc
-!===================================================================================================
-
-!===================================================================================================
-type Agrif_Variables_List
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),       pointer :: var  => NULL()
-    type(Agrif_Variables_List), pointer :: next => NULL()
-!---------------------------------------------------------------------------------------------------
-end type Agrif_Variables_List
-!===================================================================================================
-!
-!===================================================================================================
-!> Different parameters
-!
-    type(Agrif_Variable),   dimension(:), pointer :: Agrif_tabvars => NULL()
-    type(Agrif_Variable_c), dimension(:), pointer :: Agrif_tabvars_c => NULL()
-    type(Agrif_Variable_r), dimension(:), pointer :: Agrif_tabvars_r => NULL()
-    type(Agrif_Variable_l), dimension(:), pointer :: Agrif_tabvars_l => NULL()
-    type(Agrif_Variable_i), dimension(:), pointer :: Agrif_tabvars_i => NULL()
-!
-    integer               :: Agrif_Probdim          !< Problem dimension
-    integer,dimension(0:4):: Agrif_NbVariables      !< Number of variables
-    integer               :: Agrif_nbfixedgrids     !< Number of fixed grids in the grid hierarchy
-    integer, dimension(3) :: Agrif_coeffref         !< Space refinement factor
-    integer, dimension(3) :: Agrif_coeffreft        !< Time refinement factor
-    logical               :: Agrif_UseSpecialValue          !< T if use special values on the parent grid
-    logical               :: Agrif_UseSpecialValueInUpdate  !< T if use special values on the parent grid
-    logical               :: Agrif_Update_Weights = .FALSE.
-    logical               :: Agrif_UseSpecialValueFineGrid  !< T if use special values on the current grid
-    real                  :: Agrif_SpecialValue             !< Special value on the parent grid
-    real                  :: Agrif_SpecialValueFineGrid     !< Special value on the current grid
-!>
-!> \name Clustering parameters
-!> @{
-    integer               :: Agrif_Regridding = 10
-    integer               :: Agrif_Minwidth
-    real                  :: Agrif_Efficiency = 0.7
-    integer               :: MaxSearch = 5
-    real, dimension(3)    :: Agrif_mind
-!> @}
-!> \name parameters for the interpolation of the child grids
-!> @{
-    integer, parameter    :: Agrif_linear = 1           !< linear interpolation
-    integer, parameter    :: Agrif_lagrange = 2         !< lagrange interpolation
-    integer, parameter    :: Agrif_eno = 3              !< spline interpolation
-    integer, parameter    :: Agrif_user_interp = 4      !< user defined interpolation
-    integer, parameter    :: Agrif_constant = 5         !< constant interpolation
-    integer, parameter    :: Agrif_linearconserv = 6    !< linear conservative interpolation
-    integer, parameter    :: Agrif_linearconservlim = 7 !< linear conservative interpolation
-    integer, parameter    :: Agrif_ppm = 8              !< PPM interpolation
-    integer, parameter    :: Agrif_weno = 9             !< WENO5 interpolation
-    integer, parameter    :: Agrif_ppm_lim = 10         !< PPM interpolation with monotonicity
-!> @}
-!> \name parameters for the update of the parent grids
-!> @{
-    integer, parameter    :: Agrif_Update_Copy = 1              !< copy
-    integer, parameter    :: Agrif_Update_Average = 2           !< average
-    integer, parameter    :: Agrif_Update_Full_Weighting = 3    !< full-weighting
-!> @}
-!> \name Raffinement grid switches
-!> @{
-    integer               :: Agrif_USE_ONLY_FIXED_GRIDS   !< = 1 if fixed grid mode
-    integer               :: Agrif_USE_FIXED_GRIDS        !< = 1 if AMR mode + fixed grid else only AMR mode
-!> @}
-    integer               :: Agrif_Maxlevelloc
-!
-#if defined AGRIF_MPI
-    integer :: Agrif_Nbprocs  !< Number of processors
-    integer :: Agrif_ProcRank !< Rank of the current processor
-    integer :: Agrif_Group    !< Group associated to Agrif_mpi_comm
-    integer :: Agrif_mpi_comm
-#else
-    integer :: Agrif_ProcRank = 0
-#endif
-!
-    integer :: Agrif_Extra_Boundary_Cells = 3       !< When computing integration sequences, the grid rects
-                                                    !! are expanded to this number of cells.
-    logical :: Agrif_Parallel_sisters = .FALSE.     !< When TRUE, try to compute sister grids (which have the same parent)
-                                                    !! in parallel rather than sequentially.
-    logical :: agrif_regrid_has_been_done = .FALSE. !< switch to skip Agrif_Regrid call
-!
-    real, dimension(:)          , allocatable :: parray1
-    real, dimension(:,:)        , allocatable :: parray2
-    real, dimension(:,:,:)      , allocatable :: parray3
-    real, dimension(:,:,:,:)    , allocatable :: parray4
-    real, dimension(:,:,:,:,:)  , allocatable :: parray5
-    real, dimension(:,:,:,:,:,:), allocatable :: parray6
-!
-    logical :: agrif_debug = .false.    ! may be activaded in users subroutine for debugging purposes
-
-! If a grand mother grid is present
-    logical :: agrif_coarse = .false.
-    integer, dimension(3) :: coarse_spaceref = (/1,1,1/)
-    integer, dimension(3) :: coarse_timeref  = (/1,1,1/)
-!
-contains
-!
-!===================================================================================================
-!  function Agrif_Ceiling
-!---------------------------------------------------------------------------------------------------
-integer function Agrif_Ceiling ( x )
-!---------------------------------------------------------------------------------------------------
-    real,   intent(in) :: x
-!
-    integer   :: i
-!
-    i = FLOOR(x)
-!
-    if( ABS(x - i) <= 0.0001 )then
-        Agrif_Ceiling = i
-    else
-        Agrif_Ceiling = i+1
-    endif
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Ceiling
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Int
-!---------------------------------------------------------------------------------------------------
-    integer function Agrif_Int(x)
-!---------------------------------------------------------------------------------------------------
-    real,   intent(in) :: x
-!
-    integer :: i
-!
-    i = FLOOR(x) + 1
-!
-    if( ABS(x - i) <= 0.0001 )then
-        Agrif_Int = i
-    else
-        Agrif_Int = i-1
-    endif
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Int
-!===================================================================================================
-!
-end module Agrif_Types
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 10251)
@@ -0,0 +1,2677 @@
+!
+! $Id: modupdate.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Update
+C
+      Module Agrif_Update
+C
+CCC   Description:
+CCC   Module to update a parent grid from its child grids
+C
+C     Modules used:
+C   
+      Use Agrif_Updatebasic
+c      Use Agrif_Boundary
+      Use Agrif_Arrays
+      Use Agrif_CurgridFunctions
+      Use Agrif_Mask
+#ifdef key_mpp_mpi
+      Use Agrif_mpp
+#endif
+C
+      IMPLICIT NONE
+      logical, private :: precomputedone(7) = .FALSE.      
+C      
+      CONTAINS
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_1d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 1D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid       
+      External :: procname
+      Optional ::  procname      
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1)
+     &         ), Target :: tab    ! Result
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 1  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array1 => tab
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub             
+      
+C      childtemp % var % list_update => child%var%list_update
+             
+C
+     
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF     
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_1D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_2d
+C     **************************************************************************
+C 
+
+      Subroutine Agrif_Update_2d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 2D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
+                                              ! are done on the fine grid 
+                                              
+      External :: procname
+      Optional ::  procname
+                                                          
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2)
+     &    ), Target :: tab    ! Result
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 2  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array2 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub             
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_3d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 3D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid    
+      External :: procname
+      Optional ::  procname
+                                                       
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &      ), Target :: tab  ! Results  
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 3  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array3 => tab     
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      DEALLOCATE(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_3D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_4d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 4D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid     
+      External :: procname
+      Optional ::  procname        
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &      ), Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 4  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array4 => tab     
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+      
+C      childtemp % var % list_update => child%var%list_update
+            
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+
+C      child % var % list_update => childtemp%var%list_update      
+C
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_5d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 5D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid     
+      External :: procname
+      Optional ::  procname
+              
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &      ),  Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 5  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array5 => tab      
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub        
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+      
+C      child % var % list_update => childtemp%var%list_update
+            
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_5D
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_6d(TypeUpdate,parent,child,tab,deb,fin)
+C
+CCC   Description:
+CCC   Subroutine to update a 6D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid       
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &      ),  Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 6  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array6 => tab      
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      childtemp % var % list_update => child%var%list_update
+C
+      Call Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+     
+C      child % var % list_update => childtemp%var%list_update
+           
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_6D
+C
+C
+C
+C     **************************************************************************  
+C     Subroutine Agrif_UpdateVariable    
+C     **************************************************************************  
+C   
+      Subroutine Agrif_UpdateVariable(TypeUpdate,parent,child,deb,fin,
+     &                   procname)   
+C
+CCC   Description:
+CCC   Subroutine to set arguments of Agrif_UpdatenD, n being the number of
+C         dimensions of the grid variable.
+C
+CC    Declarations:
+C      
+c      
+C      
+C     Scalar argument
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+C     Data TYPE arguments
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid 
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                        !    are calculated     
+      External :: procname
+      Optional ::  procname
+      
+C
+C     Local scalars      
+      INTEGER :: nbdim                  ! Number of dimensions of the current
+                                        !    grid
+      INTEGER ,DIMENSION(6) :: pttab_child  
+      INTEGER ,DIMENSION(6) :: petab_child      
+      INTEGER ,DIMENSION(6) :: pttab_parent  
+      REAL    ,DIMENSION(6) :: s_child,s_parent
+      REAL    ,DIMENSION(6) :: ds_child,ds_parent
+      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
+                                        !    grid has a common border with 
+                                        !    the root grid            
+      TYPE(AGRIF_Variable), Pointer :: root               ! Variable on the root grid
+      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
+                                        !    variable on the cell
+      INTEGER,DIMENSION(6)          :: nbtab_Child        ! Number of the cells    
+      INTEGER :: n              
+      LOGICAL :: wholeupdate
+C
+C 
+
+      loctab_child(:) = 0
+C
+      root => child % var % root_var 
+      nbdim = root % nbdim
+C
+      do n = 1,nbdim
+        posvartab_child(n) = root % posvar(n)
+      enddo
+C      
+      
+      Call PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             nbdim)
+C
+C
+      do n = 1,nbdim
+C
+        Select case(root % interptab(n))
+C
+          case('x') ! x DIMENSION
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(1)
+C
+          case('y') ! y DIMENSION      
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(2)
+C
+          case('z') ! z DIMENSION
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(3)
+C
+          case('N') ! No space DIMENSION      
+C
+            
+            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
+C
+C           No interpolation but only a copy of the values of the grid variable      
+C      
+            posvartab_child(n) = 1
+            
+            loctab_child(n) = -3
+C
+        End select
+C
+      enddo
+      
+C     Call to a procedure of update according to the number of dimensions of
+C     the grid variable
+
+      wholeupdate = .FALSE.
+      
+      do n=1,nbdim
+      if (loctab_child(n) /= -3) then
+        if (deb(n)>fin(n)) wholeupdate = .TRUE.
+        if ((deb(n) == -99).AND.(deb(n)==fin(n))) wholeupdate=.TRUE.
+      endif
+      enddo
+
+       IF (present(procname)) THEN
+
+          IF (wholeupdate) THEN
+
+          Call AGRIF_UpdateWhole
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
+         ELSE
+          Call AGRIF_UpdateBcnD
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
+         ENDIF
+       ELSE
+         IF (wholeupdate) THEN
+          Call AGRIF_UpdateWhole
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ELSE
+          Call AGRIF_UpdateBcnD
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ENDIF
+       ENDIF
+C
+      Return
+C
+C
+      End subroutine Agrif_UpdateVariable
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_UpdateWhole
+C     **************************************************************************               
+C
+      Subroutine AGRIF_UpdateWhole(TypeUpdate,parent,child,deb,fin,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+      INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update (copy or
+                                                     !    average) 
+      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
+                                                     !    grid
+      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
+                                                     !    grid 
+      INTEGER, DIMENSION(6) :: deb, fin
+      INTEGER                  :: nbdim              ! Number of dimensions of
+                                                     !    the grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
+                                                     !    inside the domain for
+                                                     !    the parent grid
+                                                     !    variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
+                                                     !    inside the domain for
+                                                     !    the child grid
+                                                     !    variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
+                                                     !    child grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
+                                                     !    variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
+                                                     !    grid has a common
+                                                     !    border with the root
+                                                     !    grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
+                                                     !    and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
+                                                     !    and child grids
+      External :: procname
+      Optional ::  procname      
+C
+C     Local variables     
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i                 
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
+                                                     !    limits of the child
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
+                                                     !   boundary conditions are
+      integer :: coeffraf
+      INTEGER :: debloc, finloc
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif
+C      
+C
+C indtab contains the limits for the fine grid points that will be used
+C in the update scheme
+
+      DO i = 1, nbdim
+        coeffraf = nint(ds_Parent(i)/ds_Child(i))
+        debloc = 0
+        finloc = nbtab_Child(i)/coeffraf - 1
+
+        IF (posvartab_child(i) == 1) THEN
+           finloc = finloc - 1
+        ENDIF
+
+        IF (deb(i) > fin(i)) THEN
+          debloc = deb(i)
+          finloc = finloc - deb(i)
+        ENDIF
+
+        indtab(i,1,1) = pttab_child(i) + (debloc + 1) * coeffraf
+        indtab(i,1,2) = pttab_child(i) + (finloc + 1) * coeffraf
+
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
+            indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)        
+          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+          ENDIF
+        ELSE
+          indtab(i,1,1) = indtab(i,1,1) - coeffraf
+          indtab(i,1,2) = indtab(i,1,2) - 1
+C at this point, indices are OK for an average          
+          IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting)) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+          ENDIF
+        ENDIF
+        IF (loctab_child(i) == -3) THEN
+           indtab(i,1,1) = pttab_child(i)
+C
+               if (posvartab_child(i) == 1) then
+C
+               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) 
+C
+               else
+C
+               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) - 1
+               ENDIF
+        ENDIF
+      ENDDO
+
+C lubglob contains the global lbound and ubound of the child array
+C lubglob(:,1) : global lbound for each dimension
+C lubglob(:,2) : global lbound for each dimension
+
+#if !defined key_mpp_mpi
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
+     &               lubglob(:,2),nbdim)
+C
+#else
+C     
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)
+
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,2))
+
+C
+C
+           IF (present(procname)) THEN
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_child,loctab_Child,
+     &              nbdim,procname)
+           ELSE
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_child,loctab_Child,
+     &              nbdim)           
+           ENDIF        
+C
+C      
+C  
+      End Subroutine Agrif_UpdateWhole
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_UpdateBcnd
+C     **************************************************************************               
+C
+      Subroutine AGRIF_UpdateBcnd(TypeUpdate,parent,child,deb,fin,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+       INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update 
+                                                     !   (copy or average) 
+      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
+                                                     !   grid
+      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
+                                                     !   grid 
+      INTEGER, DIMENSION(6) :: deb, fin
+      INTEGER                  :: nbdim              ! Number of dimensions of
+                                                     !   the grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
+                                                     !   inside the domain for
+                                                     !   the parent grid
+                                                     !   variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
+                                                     !   inside the domain for
+                                                     !   the child grid variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
+                                                     !   child grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
+                                                     !   variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
+                                                     !   grid has a common
+                                                     !   border with the root
+                                                     !   grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
+                                                     !   and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
+                                                     !   and child grids
+      External :: procname
+      Optional ::  procname      
+C
+C     Local variables
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i                 
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
+                                                     !   limits of the child
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
+                                                     !  boundary conditions are 
+      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres      ! calculated
+      INTEGER                      :: nb,ndir,n
+      integer :: coeffraf
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif
+C      
+C
+
+      DO i = 1, nbdim
+        coeffraf = nint(ds_Parent(i)/ds_Child(i))
+        indtab(i,1,1) = pttab_child(i) + (deb(i) + 1) * coeffraf
+        indtab(i,1,2) = pttab_child(i) + (fin(i) + 1) * coeffraf
+
+        indtab(i,2,1) = pttab_child(i) + nbtab_child(i)
+     &    - (fin(i) + 1) *  coeffraf
+        indtab(i,2,2) = pttab_child(i) + nbtab_child(i)
+     &    - (deb(i) + 1) *  coeffraf
+
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
+            indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)        
+          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
+            indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
+            indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
+          ENDIF
+        ELSE
+          indtab(i,1,1) = indtab(i,1,1) - coeffraf
+          indtab(i,1,2) = indtab(i,1,2) - 1
+          indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+            indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
+            indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
+          ENDIF          
+        ENDIF
+      ENDDO
+
+#if !defined key_mpp_mpi      
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
+     &               lubglob(:,2),nbdim)
+
+C
+#else
+C     
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)  
+     
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C     
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
+     &     lubglob(1:nbdim,2))
+      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
+     &     lubglob(1:nbdim,2))
+                        
+C 
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2
+C
+          if (loctab_child(nb) /= -3) then
+C           
+              do n = 1,2
+C
+                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
+C
+              enddo              
+C
+              do i = 1,nbdim
+C     
+                if (i .NE. nb) then      
+C
+                    if (loctab_child(i) == -3) then
+C
+                        ptres(i,1,ndir,nb) = pttab_child(i)
+C
+                      else
+C
+                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+C
+                    endif
+C
+                    if (loctab_child(i) == -3) then
+C
+                        if (posvartab_child(i) == 1) then
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i) 
+     &                                + nbtab_child(i)
+C
+                          else
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i) 
+     &                             + nbtab_child(i) - 1
+C
+                        endif                             
+C
+                      else
+C
+                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+C
+                    endif                        
+C      
+                endif
+C      
+              enddo
+      
+C
+            
+        endif
+      
+        enddo
+       enddo
+C
+
+C
+
+      do nb = 1,nbdim
+C
+        do ndir = 1,2                
+C
+          if (loctab_child(nb) /= -3) then
+C
+           IF (present(procname)) THEN
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_Child,loctab_Child,
+     &              nbdim,procname,nb,ndir)
+           ELSE
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_Child,loctab_Child,
+     &              nbdim)           
+           ENDIF
+C
+          endif
+          
+C
+        enddo       
+C
+      enddo
+C
+C      
+C  
+      End Subroutine Agrif_UpdateBcnd
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_UpdatenD  
+C     **************************************************************************  
+C  
+      Subroutine Agrif_UpdatenD(TypeUpdate,parent,child,
+     &                          pttab,petab,
+     &                          pttab_Child,pttab_Parent,
+     &                          s_Child,s_Parent,
+     &                          ds_Child,ds_Parent,
+     &                          posvartab_Child,loctab_Child,
+     &                          nbdim,procname,nb,ndir)  
+C
+C     Description:
+C     Subroutine to update a 2D grid variable on the parent grid of 
+C        the current grid. 
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+       INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER                    :: nbdim
+      INTEGER, DIMENSION(6) :: TypeUpdate              ! TYPE of update 
+                                                       !  (copy or average)
+      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
+                                                       !   grid   
+      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
+                                                       !   grid
+      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
+                                                       !   point inside the
+                                                       !   domain
+      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
+                                                       !   point inside the
+                                                       !   domain
+      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
+                                                       !   point inside the
+                                                       !   domain for the child
+                                                       !   grid variable
+      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
+                                                       !   point inside the
+                                                       !   domain for the parent
+                                                       !   grid variable
+      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
+                                                       !   and child grids
+      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
+                                                       !   parent and child
+                                                       !   grids 
+      External :: procname
+      Optional ::  procname
+      Integer :: nb,ndir
+      Optional :: nb,ndir
+      
+C
+C     Local pointers
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempP      ! Temporary parent grid variable
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempC      ! Temporary child grid variable
+C
+C     Local scalars
+      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim)    :: posvartab_Child,loctab_Child
+      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
+      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
+      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
+cccccccc      LOGICAL,DIMENSION(nbdim)    :: noraftab
+      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
+      LOGICAL :: memberin, member
+      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
+      INTEGER,DIMENSION(nbdim,2,2) :: childarray
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempCextend,tempPextend ! Temporary child
+      INTEGER :: nbin, ndirin
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
+      INTEGER                              :: code
+      INTEGER                              :: i,j,k
+      INTEGER,DIMENSION(nbdim,4)           :: tab3
+      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL :: find_list_update
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+      LOGICAL, DIMENSION(1) :: memberin1      
+C
+#endif
+C
+  
+C
+C     local lbound and ubound of the child array
+
+      Call Agrif_nbdim_Get_bound_dimension(child%var,
+     &                              lowerbound,upperbound,nbdim)
+
+C here pttab and petab corresponds to the (global) indices of the points needed
+C in the update
+C pttruetab and cetruetab contains only indices that are present
+C on the local processor
+
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       pttab,petab,
+     &                       pttruetab,cetruetab,memberin)
+
+       Call Agrif_Prtbounds(nbdim,indminglob,indmaxglob,s_Parent_temp,
+     &                     s_Child_temp,s_Child,ds_Child,
+     &                     s_Parent,ds_Parent,
+     &                     pttab,petab,pttab_Child,
+     &                     pttab_Parent,
+     &                     posvartab_Child,TypeUpdate,loctab_Child
+#ifdef key_mpp_mpi
+     &                 ,pttruetabwhole,cetruetabwhole
+#endif
+     &     )
+
+#ifdef key_mpp_mpi
+      IF (memberin) THEN
+       Call Agrif_GlobtoLocInd2(childarray,
+     &                     lowerbound,upperbound,
+     &                     pttruetab,cetruetab,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+
+      ENDIF
+
+
+         Call Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
+     &                     s_Child_temp,s_Child,ds_Child,
+     &                     s_Parent,ds_Parent,
+     &                     pttruetab,cetruetab,pttab_Child,
+     &                     pttab_Parent,
+     &                     posvartab_Child,TypeUpdate,loctab_Child
+     &                 ,pttruetabwhole,cetruetabwhole
+     &     )
+
+#else
+       indmin = indminglob
+       indmax = indmaxglob
+       pttruetabwhole = pttruetab
+       cetruetabwhole = cetruetab
+       childarray(:,1,2) = pttruetab
+       childarray(:,2,2) = cetruetab
+#endif
+
+       IF (present(procname)) THEN
+       IF (.Not.present(nb)) THEN
+       nbin=0
+       ndirin=0
+       ELSE
+       nbin = nb
+       ndirin = ndir
+       ENDIF
+       ENDIF
+       
+      IF (memberin) THEN
+      IF (.not.associated(tempC%var)) allocate(tempC%var)
+
+C
+      Call Agrif_nbdim_allocation(tempC%var,
+     &                 pttruetab,cetruetab,nbdim)
+
+      Call Agrif_nbdim_Full_VarEQreal(tempC%var,0.,nbdim)
+
+      IF (present(procname)) THEN
+        SELECT CASE (nbdim)
+        CASE(1)
+          CALL procname(tempC%var%array1,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(2)
+          CALL procname(tempC%var%array2,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(3)
+          CALL procname(tempC%var%array3,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(4)
+          CALL procname(tempC%var%array4,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(5)
+          CALL procname(tempC%var%array5,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                          childarray(5,1,2),childarray(5,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(6)
+          CALL procname(tempC%var%array6,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                          childarray(5,1,2),childarray(5,2,2),
+     &                          childarray(6,1,2),childarray(6,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        END SELECT
+      ELSE
+      Call Agrif_nbdim_VarEQvar(tempC%var,pttruetab,cetruetab,
+     &          child%var,childarray(:,1,2),childarray(:,2,2),
+     &                          nbdim)
+      ENDIF
+
+      ENDIF
+
+
+
+C
+C
+#ifdef key_mpp_mpi
+C
+C     tab2 contains the necessary limits of the parent grid for each processor
+
+      IF (Associated(child%var%list_update)) THEN
+      Call Agrif_Find_list_update(child%var%list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &       find_list_update,tab4t,tab5t,memberinall,memberinall2,
+     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+      ELSE
+      find_list_update = .FALSE.
+      ENDIF
+      
+      if (.not.find_list_update) then      
+      tab3(:,1) = pttruetab(:)
+      tab3(:,2) = cetruetab(:)
+      tab3(:,3) = pttruetabwhole(:)
+      tab3(:,4) = cetruetabwhole(:)
+C
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var)
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab4t(i,k,j) = tab4(i,j,k)
+         enddo
+       enddo
+      enddo
+      
+      memberin1(1) = memberin
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+ 
+       Call Get_External_Data_first(tab4t(:,:,1),
+     &            tab4t(:,:,2),
+     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
+     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
+     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+               
+      endif
+
+      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
+     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
+     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,
+     &            tempCextend) 
+           
+!      Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1),
+!     &            tab4t(:,:,2),
+!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
+!     &            memberinall)
+
+#else
+      tempCextend%var => tempC%var
+#endif
+
+C
+C
+C     Update of the parent grid (tempP) from the child grid (tempC)
+
+
+      IF (memberin) THEN
+
+      IF (.not.associated(tempP%var)) allocate(tempP%var)
+      Call Agrif_nbdim_allocation(tempP%var,
+     &                 indmin,indmax,nbdim)
+
+      if ( nbdim .EQ. 1 ) then
+         tempP%var%array1 = 0.
+         Call Agrif_Update_1D_recursive(TypeUpdate,
+     &           tempP%var%array1,tempCextend%var%array1,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 2 ) then
+         Call Agrif_Update_2D_recursive(TypeUpdate,
+     &           tempP%var%array2,tempCextend%var%array2,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+
+      if ( nbdim .EQ. 3 ) then
+         Call Agrif_Update_3D_recursive(TypeUpdate,
+     &           tempP%var%array3,tempCextend%var%array3,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 4 ) then
+         Call Agrif_Update_4D_recursive(TypeUpdate,
+     &           tempP%var%array4,tempCextend%var%array4,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 5 ) then
+         Call Agrif_Update_5D_recursive(TypeUpdate,
+     &           tempP%var%array5,tempCextend%var%array5,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 6 ) then
+         Call Agrif_Update_6D_recursive(TypeUpdate,
+     &           tempP%var%array6,tempCextend%var%array6,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+
+      Call Agrif_nbdim_deallocation(tempCextend%var,nbdim)
+C      Deallocate(tempCextend%var)
+
+      ENDIF
+
+#ifdef key_mpp_mpi
+      Call Agrif_nbdim_Get_bound_dimension(parent%var,
+     &                              lowerbound,upperbound,nbdim)
+
+      Call Agrif_ChildGrid_to_ParentGrid()
+C
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       indminglob,indmaxglob,
+     &                       indminglob2,indmaxglob2,member)
+C
+      IF (member) THEN
+      Call Agrif_GlobtoLocInd2(parentarray,
+     &                     lowerbound,upperbound,
+     &                     indminglob2,indmaxglob2,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+      ENDIF
+
+      Call Agrif_ParentGrid_to_ChildGrid()
+
+      if (.not.find_list_update) then
+      tab3(:,1) = indmin(:)
+      tab3(:,2) = indmax(:)
+      tab3(:,3) = indminglob2(:)
+      tab3(:,4) = indmaxglob2(:)
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab5t(i,k,j) = tab4(i,j,k)
+         enddo
+       enddo
+      enddo
+ 
+      memberin1(1) = member
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+ 
+      Call Get_External_Data_first(tab5t(:,:,1),
+     &            tab5t(:,:,2),
+     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
+     &            memberinall2,sendtoproc2,recvfromproc2,tab5t(:,:,5),
+     & tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
+          
+      Call Agrif_Addto_list_update(child%var%list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim
+     &   ,tab4t,tab5t,memberinall,memberinall2,
+     &   sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 
+          
+      endif
+      
+c      Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1),
+c     &            tab5t(:,:,2),
+c     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
+c     &            memberinall2)
+     
+      Call ExchangeSameLevel2(sendtoproc2,recvfromproc2,nbdim,
+     &            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),
+     &            tab5t(:,:,7),tab5t(:,:,8),member,tempP,
+     &            tempPextend)     
+
+#else
+      tempPextend%var => tempP%var
+      parentarray(:,1,1) = indmin
+      parentarray(:,2,1) = indmax
+      parentarray(:,1,2) = indmin
+      parentarray(:,2,2) = indmax
+      member = .TRUE.
+#endif
+
+C
+C
+C
+C     Special values on the child grid
+      if (Agrif_UseSpecialValueFineGrid) then
+C
+ccc         noraftab(1:nbdim) =
+ccc     &    child % var % root_var % interptab(1:nbdim) .EQ. 'N'
+C
+#ifdef key_mpp_mpi
+C
+c          Allocate(childvalues% var)
+C
+c          Call Agrif_nbdim_allocation(childvalues%var,
+c     &                      pttruetab,cetruetab,nbdim)
+c          Call Agrif_nbdim_Full_VarEQvar(childvalues% var,
+c     &                                tempC% var,
+c     &                                nbdim)
+c          Call Agrif_CheckMasknD(tempC,childvalues,
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           noraftab(1:nbdim),nbdim)
+c          Call Agrif_nbdim_deallocation(childvalues% var,nbdim)
+c         Deallocate(childvalues % var)
+C
+#else
+C
+c          Call Agrif_nbdim_Get_bound_dimension(child%var,
+c     &                              lowerbound,upperbound,nbdim)
+c          Call Agrif_CheckMasknD(tempC,child,
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           lowerbound,
+c     &                           upperbound,
+c     &                           noraftab(1:nbdim),nbdim)
+C
+#endif
+C
+      endif
+
+
+C
+C
+C
+C
+C     Special values on the parent grid
+      if (Agrif_UseSpecialValue) then
+C
+#ifdef key_mpp_mpi
+C
+c          Call GiveAgrif_SpecialValueToTab_mpi(parent%var,tempP%var,
+c     &                 parentarray,
+c     &                 indmin,indmax,
+c     &                 Agrif_SpecialValue,nbdim)
+C
+C
+#else
+C
+c          Call GiveAgrif_SpecialValueToTab(parent%var,tempP%var,
+c     &                  indmin,indmax,
+c     &                  Agrif_SpecialValue,nbdim)
+C
+#endif
+C
+C
+      endif   
+C
+C
+        IF (member) THEN
+
+          IF (present(procname)) THEN
+            CALL Agrif_ChildGrid_to_ParentGrid()
+            SELECT CASE(nbdim)
+            CASE(1)
+            CALL procname(
+     &      tempPextend%var%array1(
+     &                      parentarray(1,1,1):parentarray(1,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(2)
+            CALL procname(
+     &      tempPextend%var%array2(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(3)
+            CALL procname(
+     &      tempPextend%var%array3(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(4)
+            CALL procname(
+     &      tempPextend%var%array4(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(5)
+            CALL procname(
+     &      tempPextend%var%array5(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                      parentarray(5,1,2),parentarray(5,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(6)
+            CALL procname(
+     &      tempPextend%var%array6(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1),
+     &                      parentarray(6,1,1):parentarray(6,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                      parentarray(5,1,2),parentarray(5,2,2),
+     &                      parentarray(6,1,2),parentarray(6,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            END SELECT
+            CALL Agrif_ParentGrid_to_ChildGrid()
+          ELSE
+            SELECT CASE(nbdim)
+            CASE(1)
+            parent%var%array1(parentarray(1,1,2):parentarray(1,2,2)) =
+     &      tempPextend%var%array1(
+     &                      parentarray(1,1,1):parentarray(1,2,1))
+            CASE(2)
+            parent%var%array2(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2)) =
+     &      tempPextend%var%array2(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1))
+            CASE(3)
+            parent%var%array3(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2)) =
+     &      tempPextend%var%array3(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1))
+            CASE(4)
+            parent%var%array4(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2)) =
+     &      tempPextend%var%array4(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1))
+            CASE(5)
+            parent%var%array5(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2),
+     &                      parentarray(5,1,2):parentarray(5,2,2)) =
+     &      tempPextend%var%array5(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1))
+            CASE(6)
+            parent%var%array6(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2),
+     &                      parentarray(5,1,2):parentarray(5,2,2),
+     &                      parentarray(6,1,2):parentarray(6,2,2)) =
+     &      tempPextend%var%array6(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1),
+     &                      parentarray(6,1,1):parentarray(6,2,1))
+            END SELECT
+          ENDIF
+
+        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
+       ENDIF
+C
+C
+C     Deallocations
+
+      IF (memberin) THEN
+#ifdef key_mpp_mpi
+      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
+      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
+!      Deallocate(tempC % var)
+#endif
+!      Deallocate(tempP % var)
+      ENDIF
+#ifdef key_mpp_mpi
+!      Deallocate(tempPextend%var)
+!      IF (.Not.memberin) Deallocate(tempCextend%var)
+#endif
+
+C
+C
+      End Subroutine Agrif_UpdatenD
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Prtbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
+     &                              s_Child_temp,s_Child,ds_Child,
+     &                              s_Parent,ds_Parent,
+     &                              pttruetab,cetruetab,pttab_Child,
+     &                              pttab_Parent,
+     &                              posvartab_child,TypeUpdate,
+     &                              loctab_Child
+#ifdef key_mpp_mpi
+     &                 ,pttruetabwhole,cetruetabwhole
+#endif
+     &                 )
+C
+CCC   Description:
+CCC   Subroutine calculating the bounds of the parent grid to be updated
+CCC   by the child grid     
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+cccccccccccccccccccccccccc#include "mpif.h"
+#endif
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: indmin,indmax
+      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
+      REAL,DIMENSION(nbdim) :: s_Child,ds_child
+      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
+      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim) :: posvartab_child,TypeUpdate
+      INTEGER,DIMENSION(nbdim) :: loctab_Child
+      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
+C
+C     Local variables
+      INTEGER :: i
+      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
+#ifdef key_mpp_mpi
+      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
+      REAL :: positionmin,positionmax
+      INTEGER :: imin,imax
+      INTEGER :: coeffraf
+#endif
+C
+C
+      do i = 1,nbdim
+C
+        dim_newmin(i) = s_Child(i) + (pttruetab(i) -
+     &                                pttab_Child(i)) * ds_Child(i)
+C
+        dim_newmax(i) = s_Child(i) + (cetruetab(i) - 
+     &                                pttab_Child(i)) * ds_Child(i)
+C     
+        indmin(i) = pttab_Parent(i) +
+     &        agrif_ceiling((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+C
+        indmax(i) = pttab_Parent(i) +
+     &        agrif_int((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
+C
+#ifdef key_mpp_mpi
+        positionmin = s_Parent(i) + (indmin(i)-
+     &                          pttab_Parent(i))*ds_Parent(i)
+        IF (loctab_Child(i) .NE. -3) THEN
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
+          positionmin = positionmin - ds_Parent(i)/2.
+          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+          positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+          ENDIF
+        ELSE
+          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN
+        positionmin = positionmin - ds_Parent(i)/2.
+          ELSE
+          coeffraf = nint(ds_Parent(i)/ds_Child(i))
+          if (mod(coeffraf,2) == 1) then
+            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+          else
+            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+     &                                -ds_Child(i)/2.
+          endif
+        ENDIF
+        ENDIF
+        ENDIF
+        imin = pttab_Child(i) +
+     &        agrif_ceiling((positionmin-s_Child(i))/ds_Child(i))
+
+       positionmin = s_Child(i) + (imin -
+     &                             pttab_Child(i)) * ds_Child(i)
+
+        pttruetabwhole(i) = imin
+
+        positionmax = s_Parent(i) + (indmax(i)-
+     &                          pttab_Parent(i))*ds_Parent(i)
+        IF (loctab_Child(i) .NE. -3) THEN
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
+        positionmax = positionmax  + ds_Parent(i)/2.
+          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+          positionmax = positionmax  + (ds_Parent(i)-ds_Child(i))
+          ENDIF
+        ELSE
+          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN        
+        positionmax = positionmax  + ds_Parent(i)/2.
+          ELSE
+          coeffraf = nint(ds_Parent(i)/ds_Child(i))
+          if (mod(coeffraf,2) == 1) then
+            positionmax = positionmax + (ds_Parent(i)-ds_Child(i))
+          else
+            positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) 
+     &                                + ds_Child(i)/2.
+          endif
+
+        ENDIF        
+        ENDIF
+        ENDIF
+        imax = pttab_Child(i) +
+     &        agrif_int((positionmax-s_Child(i))/ds_Child(i))
+
+        positionmax = s_Child(i) + (imax -
+     &                                pttab_Child(i)) * ds_Child(i)
+
+        cetruetabwhole(i) = imax
+
+#endif
+C
+        s_Parent_temp(i) = s_Parent(i) + 
+     &                     (indmin(i) - pttab_Parent(i)) * 
+     &                      ds_Parent(i) 
+C     
+        s_Child_temp(i) = dim_newmin(i)
+
+#ifdef key_mpp_mpi
+        s_Child_temp(i) = positionmin
+#endif
+C
+      enddo
+C
+      Return
+C
+C
+      End Subroutine Agrif_Prtbounds
+C
+C
+C
+C
+
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_2D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_2D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 2D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_1D_Recursive and Agrif_UpdateBase.   
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2))           :: tempP
+C      REAL, DIMENSION(pttab_child(1):petab_child(1),
+C     &                pttab_child(2):petab_child(2)) :: tempC
+     
+      REAL, DIMENSION(:,:) :: tempC     
+C
+C     Local variables      
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                 pttab_child(2):petab_child(2)) :: tabtemp
+      REAL, DIMENSION(indmin(2):indmax(2),
+     &                indmin(1):indmax(1))           :: tempP_trsp
+      REAL, DIMENSION(pttab_child(2):petab_child(2),
+     &                 indmin(1):indmax(1)) :: tabtemp_trsp
+      INTEGER :: i,j
+      INTEGER :: coeffraf,locind_child_left
+C
+      tabtemp = 0.
+
+
+      coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
+      IF((TypeUpdate(1) == AGRIF_Update_average) 
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(1) ) Call average1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+          Call average1Daftercompute
+     &       (  tabtemp, tempC,
+     &          size(tabtemp), size(tempC),
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+ 
+      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(1) ) Call copy1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+          Call copy1Daftercompute
+     &       (  tabtemp, tempC,
+     &          size(tabtemp), size(tempC),
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+
+      ELSE
+      do j = pttab_child(nbdim),petab_child(nbdim)
+C
+!---CDIR NEXPAND
+        Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(:,j),
+     &         tempC(:,j-pttab_child(nbdim)+1),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      ENDIF
+      tabtemp_trsp = TRANSPOSE(tabtemp) 
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+    
+!---CDIR NEXPAND
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      
+      tempP_trsp = 0. 
+
+      IF((TypeUpdate(2) == AGRIF_Update_average)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(2) ) Call average1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+          Call average1Daftercompute
+     &       (  tempP_trsp, tabtemp_trsp,
+     &          size(tempP_trsp), size(tabtemp_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(2) ) Call copy1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+          Call copy1Daftercompute
+     &       (  tempP_trsp, tabtemp_trsp,
+     &          size(tempP_trsp), size(tabtemp_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSE
+
+      do i = indmin(1),indmax(1)
+C
+!---CDIR NEXPAND
+        Call Agrif_UpdateBase(TypeUpdate(2),
+     &           tempP_trsp(indmin(nbdim):indmax(nbdim),i),
+     &          tabtemp_trsp(pttab_child(nbdim):petab_child(nbdim),i),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C        
+      enddo
+      
+      ENDIF
+
+      tempP = TRANSPOSE(tempP_trsp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_2D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_3D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_3D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 3D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_2D_Recursive and Agrif_UpdateBase.   
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2), 
+     &                 pttab_child(3):petab_child(3)) :: tabtemp
+      INTEGER :: i,j,k
+      INTEGER :: coeffraf,locind_child_left
+      INTEGER :: kdeb
+C
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeUpdate(1) == AGRIF_Update_average)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call average1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call copy1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ENDIF
+
+      coeffraf = nint ( ds_parent(2) / ds_child(2) )
+      IF((TypeUpdate(2) == AGRIF_Update_average)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call average1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call copy1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ENDIF
+
+
+      do k = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_2D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(:,:,k),
+     &         tempC(:,:,k),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+C
+      precomputedone(1) = .FALSE.
+      precomputedone(2) = .FALSE.
+      coeffraf = nint ( ds_parent(3) / ds_child(3) )
+
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      
+      IF (coeffraf == 1) THEN
+      
+      kdeb = pttab_child(3)+locind_child_left-2
+      do k=indmin(3),indmax(3)
+      kdeb = kdeb + 1
+      do j = indmin(2),indmax(2)
+        do i = indmin(1),indmax(1)
+        tempP(i,j,k) = tabtemp(i,j,kdeb)
+      enddo
+      enddo
+      enddo
+              
+      ELSE
+      tempP = 0.
+C
+      do j = indmin(2),indmax(2)
+C
+        do i = indmin(1),indmax(1)
+C
+          Call Agrif_UpdateBase(TypeUpdate(3),
+     &           tempP(i,j,:),
+     &          tabtemp(i,j,:),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+        enddo 
+C        
+      enddo
+      ENDIF
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_3D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_4D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_4D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 4D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_3D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3), 
+     &                 pttab_child(4):petab_child(4)))
+C
+      do l = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_3D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),l),
+     &         tempC(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),l),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      tempP = 0.
+
+      do k = indmin(3),indmax(3)
+C
+        do j = indmin(2),indmax(2)
+C
+          do i = indmin(1),indmax(1)
+C
+            Call Agrif_UpdateBase(TypeUpdate(4),
+     &           tempP(i,j,k,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_4D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_5D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_5D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 5D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_4D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4),
+     &                indmin(5):indmax(5))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4),
+     &                pttab_child(5):petab_child(5)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l,m
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3),
+     &                 indmin(4):indmax(4),   
+     &                 pttab_child(5):petab_child(5)))
+C
+      do m = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_4D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-4):indmax(nbdim-4),
+     &                 indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),m),
+     &         tempC(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &               pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),m),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      tempP = 0.
+C
+      do l = indmin(4),indmax(4)
+C
+        do k = indmin(3),indmax(3)
+C
+          do j = indmin(2),indmax(2)
+C
+            do i = indmin(1),indmax(1)
+C
+              Call Agrif_UpdateBase(TypeUpdate(5),
+     &           tempP(i,j,k,l,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,l,
+     &                   pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+            enddo
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_5D_recursive
+C
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_6D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_6D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 6D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_5D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4),
+     &                indmin(5):indmax(5),
+     &                indmin(6):indmax(6))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4),
+     &                pttab_child(5):petab_child(5),
+     &                pttab_child(6):petab_child(6)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l,m,n
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3),
+     &                 indmin(4):indmax(4),   
+     &                 indmin(5):indmax(5),   
+     &                 pttab_child(6):petab_child(6)))
+C
+      do n = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_5D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-5):indmax(nbdim-5),
+     &                 indmin(nbdim-4):indmax(nbdim-4),
+     &                 indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),n),
+     &         tempC(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &               pttab_child(nbdim-4):petab_child(nbdim-4),
+     &               pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),n),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      tempP = 0.
+
+      do m = indmin(5),indmax(5)
+      do l = indmin(4),indmax(4)
+C
+        do k = indmin(3),indmax(3)
+C
+          do j = indmin(2),indmax(2)
+C
+            do i = indmin(1),indmax(1)
+C
+              Call Agrif_UpdateBase(TypeUpdate(6),
+     &           tempP(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,l,m,
+     &                   pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+            enddo
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_6D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_UpdateBase  
+C     **************************************************************************  
+C  
+      Subroutine Agrif_UpdateBase(TypeUpdate,
+     &                            parenttab,childtab,
+     &                            indmin,indmax,pttab_child,petab_child,
+     &                            s_parent,s_child,ds_parent,ds_child,
+     &                            coeffraf,locind_child_left)
+C
+CCC   Description:
+CCC   Subroutine calling the updating method chosen by the user (copy, average
+CCC   or full-weighting).    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C
+      INTEGER :: TypeUpdate
+      INTEGER :: indmin,indmax
+      INTEGER :: pttab_child,petab_child
+      REAL,DIMENSION(indmin:indmax)           :: parenttab       
+      REAL,DIMENSION(pttab_child:petab_child) :: childtab      
+      REAL    :: s_parent,s_child
+      REAL    :: ds_parent,ds_child      
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      if (TypeUpdate == AGRIF_Update_copy) then
+C             
+          Call agrif_copy1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child)     
+C
+        elseif (TypeUpdate == AGRIF_Update_average) then
+C           
+          Call average1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child) 
+C
+        elseif (TypeUpdate == AGRIF_Update_full_weighting) then
+C             
+          Call full_weighting1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child,
+     &          coeffraf,locind_child_left)
+C
+      endif 
+C
+      Return                
+C
+C      
+      End Subroutine Agrif_UpdateBase
+C
+C
+
+      Subroutine Agrif_Compute_nbdim_update(s_parent,s_child,
+     &  ds_parent,ds_child,coeffraf,locind_child_left)
+      real :: s_parent,s_child,ds_parent,ds_child
+      integer :: coeffraf,locind_child_left
+     
+      coeffraf = nint(ds_parent/ds_child)
+      locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
+      
+      End Subroutine Agrif_Compute_nbdim_update
+ 
+#if defined key_mpp_mpi      
+      Subroutine Agrif_Find_list_update(list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &     find_list_update,tab4t,tab5t,memberinall,memberinall2,
+     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)     
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      LOGICAL :: find_list_update
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+      INTEGER :: i
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall,memberinall2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1      
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
+                    
+      find_list_update = .FALSE.
+      
+      parcours => list_update
+      
+      Find_loop :   Do While (associated(parcours))
+        Do i=1,nbdim
+          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
+     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
+     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
+     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
+     &               THEN
+            parcours=>parcours%suiv
+            Cycle Find_loop
+          ENDIF
+        EndDo
+        
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        
+        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall2 = 
+     &       parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
+        sendtoproc1 = 
+     &       parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)   
+        recvfromproc1 = 
+     &       parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)     
+        sendtoproc2 = 
+     &       parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)   
+        recvfromproc2 = 
+     &       parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)          
+        
+        find_list_update = .TRUE.   
+        Exit Find_loop
+      End Do Find_loop  
+                              
+      End Subroutine Agrif_Find_list_update  
+      
+      Subroutine Agrif_AddTo_list_update(list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim
+     &      ,tab4t,tab5t,memberinall,memberinall2,
+     &      sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+          
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1      
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2, recvfromproc2
+
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+            
+       Allocate(parcours)
+      Allocate(parcours%interp_loc)
+      
+      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
+      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
+      
+      Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))      
+      Allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))            
+            
+      parcours%interp_loc%tab4t=tab4t   
+      parcours%interp_loc%memberinall=memberinall
+ 
+      parcours%interp_loc%tab5t=tab5t   
+      parcours%interp_loc%memberinall2=memberinall2
+      parcours%interp_loc%sendtoproc1=sendtoproc1   
+      parcours%interp_loc%recvfromproc1=recvfromproc1      
+      parcours%interp_loc%sendtoproc2=sendtoproc2       
+      parcours%interp_loc%recvfromproc2=recvfromproc2      
+            
+      parcours%suiv => list_update
+      
+      list_update => parcours
+      
+      End Subroutine Agrif_Addto_list_update
+#endif
+           
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_1D_Recursive
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_1D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 1D grid variable on the parent grid.
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C
+C     Arguments
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(nbdim):indmax(nbdim))           :: tempP
+      REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tempC
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      
+      Call Agrif_UpdateBase(TypeUpdate(1),
+     &                  tempP(indmin(nbdim):indmax(nbdim)),
+     &                  tempC(pttab_child(nbdim):petab_child(nbdim)),
+     &                  indmin(nbdim),indmax(nbdim),           
+     &                  pttab_child(nbdim),petab_child(nbdim),
+     &                  s_parent(nbdim),s_child(nbdim),
+     &                  ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_1D_recursive      
+
+      End Module Agrif_Update
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 10250)
+++ 	(revision )
@@ -1,2130 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-!
-!> Module Agrif_Update
-!>
-!> This module  contains procedures to update a parent grid from its child grids.
-!
-module Agrif_Update
-!
-    use Agrif_UpdateBasic
-    use Agrif_Arrays
-    use Agrif_CurgridFunctions
-    use Agrif_Mask
-#if defined AGRIF_MPI
-    use Agrif_Mpp
-#endif
-!
-    implicit none
-!
-    logical, private :: precomputedone(7) = .FALSE.
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_UpdateVariable
-!
-!> subroutine to set arguments for Agrif_UpdatenD
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_UpdateVariable ( parent, child, updateinf, updatesup, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),  pointer      :: parent       !< Variable on the parent grid
-    type(Agrif_Variable),  pointer      :: child        !< Variable on the child grid
-    integer, dimension(6), intent(in)   :: updateinf    !< First positions where interpolations are calculated
-    integer, dimension(6), intent(in)   :: updatesup    !< Last  positions where interpolations are calculated
-    procedure()                         :: procname     !< Data recovery procedure
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(6) :: nb_child           ! Number of cells on the child grid
-    integer, dimension(6) :: lb_child
-    integer, dimension(6) :: ub_child
-    integer, dimension(6) :: lb_parent
-    real   , dimension(6) ::  s_child           ! Child  grid position (s_root = 0)
-    real   , dimension(6) ::  s_parent          ! Parent grid position (s_root = 0)
-    real   , dimension(6) :: ds_child           ! Child  grid dx (ds_root = 1)
-    real   , dimension(6) :: ds_parent          ! Parent grid dx (ds_root = 1)
-    logical, dimension(6) :: do_update          ! Indicates if we perform update for each dimension
-    integer, dimension(6) :: posvar             ! Position of the variable on the cell (1 or 2)
-    integer, dimension(6) :: oldparentlbound, oldparentubound
-    integer               :: n, nbdim
-    logical               :: wholeupdate
-    type(Agrif_Variable), pointer :: root   ! Variable on the root grid
-!
-    root => child % root_var
-    nbdim = root % nbdim
-!
-    call PreProcessToInterpOrUpdate( parent,   child,       &
-                                     nb_child, ub_child,    &
-                                     lb_child, lb_parent,   &
-                                      s_child,  s_parent,   &
-                                     ds_child, ds_parent, nbdim, interp=.false. )
-!
-    do_update(:) = .true.
-    posvar(1:nbdim) = root % posvar(1:nbdim)
-!
-    do n = 1,nbdim
-!
-        if ( root % interptab(n) == 'N' ) then
-            posvar(n) = 1
-            do_update(n) = .false.
-            oldparentlbound(n) = parent % lb(n)
-            oldparentubound(n) = parent % ub(n)
-            parent % lb(n) = child % lb(n)
-            parent % ub(n) = child % ub(n)
-        end if
-!
-    enddo
-
-    wholeupdate = .FALSE.
-!
-    do n = 1,nbdim
-        if ( do_update(n) ) then
-            if ( (updateinf(n) > updatesup(n)) .OR. &
-                ((updateinf(n) == -99) .AND. (updatesup(n) == -99)) &
-               ) then
-                wholeupdate = .TRUE.
-            endif
-        endif
-    enddo
-!
-    IF (wholeupdate) THEN
-        call Agrif_UpdateWhole(parent, child,               &
-                updateinf(1:nbdim), updatesup(1:nbdim),     &
-                lb_child(1:nbdim), lb_parent(1:nbdim),      &
-                nb_child(1:nbdim), posvar(1:nbdim),         &
-                do_update(1:nbdim),                         &
-                s_child(1:nbdim),   s_parent(1:nbdim),      &
-                ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname)
-    ELSE
-        call Agrif_UpdateBcnD(parent, child,                &
-                updateinf(1:nbdim), updatesup(1:nbdim),     &
-                lb_child(1:nbdim), lb_parent(1:nbdim),      &
-                nb_child(1:nbdim), posvar(1:nbdim),         &
-                do_update(1:nbdim),                         &
-                s_child(1:nbdim),   s_parent(1:nbdim),      &
-                ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname)
-    ENDIF
-!
-    do n = 1,nbdim
-!
-        if ( root % interptab(n) == 'N' ) then  ! No space DIMENSION
-            parent % lb(n) = oldparentlbound(n)
-            parent % ub(n) = oldparentubound(n)
-        end if
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_UpdateVariable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_UpdateWhole
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_UpdateWhole ( parent, child, uinf, usup,       &
-                               lb_child, lb_parent,             &
-                               nb_child, posvar,                &
-                               do_update,                       &
-                               s_child,   s_parent,             &
-                               ds_child, ds_parent, nbdim, procname )
-!---------------------------------------------------------------------------------------------------
-#if defined AGRIF_MPI
-    include 'mpif.h'
-#endif
-!
-    type(Agrif_Variable),      pointer    :: parent         !< Variable on the parent grid
-    type(Agrif_Variable),      pointer    :: child          !< Variable on the child grid
-    integer, dimension(nbdim), intent(in) :: uinf           !< First positions where interpolations are calculated
-    integer, dimension(nbdim), intent(in) :: usup           !< Last  positions where interpolations are calculated
-    integer,                   intent(in) :: nbdim          !< Number of dimensions of the grid variable
-    integer, dimension(nbdim), intent(in) :: lb_child       !< Index of the first point inside the domain for the parent grid variable
-    integer, dimension(nbdim), intent(in) :: lb_parent      !< Index of the first point inside the domain for the child grid variable
-    integer, dimension(nbdim), intent(in) :: nb_child       !< Number of cells of the child grid
-    integer, dimension(nbdim), intent(in) :: posvar         !< Position of the variable on the cell (1 or 2)
-    logical, dimension(nbdim), intent(in) :: do_update      !< Indicates if we update for each dimension
-    real,    dimension(nbdim), intent(in) :: s_child        !< Positions of the child grid
-    real,    dimension(nbdim), intent(in) :: s_parent       !< Positions of the parent grid
-    real,    dimension(nbdim), intent(in) :: ds_child       !< Space steps of the child grid
-    real,    dimension(nbdim), intent(in) :: ds_parent      !< Space steps of the parent grid
-    procedure()                           :: procname       !< Data recovery procedure
-!
-    integer, dimension(nbdim)     :: type_update ! Type of update (copy or average)
-    integer, dimension(nbdim,2)   :: lubglob
-    integer, dimension(nbdim,2,2) :: indtab      ! limits of the child grid that will be used in the update scheme
-    integer, dimension(nbdim,2,2) :: indtruetab  ! grid variable where boundary conditions are
-    integer :: coeffraf, i
-    integer :: uinfloc, usuploc
-!
-    type_update = child % root_var % type_update(1:nbdim)
-!
-    do i = 1, nbdim
-!
-        if ( do_update(i) ) then
-!
-            coeffraf = nint(ds_parent(i)/ds_child(i))
-            uinfloc = 0
-            usuploc = nb_child(i)/coeffraf - 1
-
-            IF (posvar(i) == 1) THEN
-                usuploc = usuploc - 1
-            ENDIF
-
-            IF (uinf(i) > usup(i)) THEN
-                uinfloc = uinf(i)
-                usuploc = usuploc - uinf(i)
-            ENDIF
-
-            indtab(i,1,1) = lb_child(i) + (uinfloc + 1) * coeffraf
-            indtab(i,1,2) = lb_child(i) + (usuploc + 1) * coeffraf
-
-            IF ( posvar(i) == 1 ) THEN
-                IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN
-                    indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
-                    indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)
-                ELSE IF ( type_update(i) /= Agrif_Update_Copy ) THEN
-                    indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
-                    indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
-                ENDIF
-            ELSE
-                indtab(i,1,1) = indtab(i,1,1) - coeffraf
-                indtab(i,1,2) = indtab(i,1,2) - 1
-    ! at this point, indices are OK for an average
-                IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN
-                    indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
-                    indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
-                ENDIF
-            ENDIF
-!
-        else    ! IF ( .not.do_update(i) ) THEN
-!
-            if ( posvar(i) == 1 ) then
-                indtab(i,1,1) = lb_child(i)
-                indtab(i,1,2) = lb_child(i) + nb_child(i)
-            else
-                indtab(i,1,1) = lb_child(i)
-                indtab(i,1,2) = lb_child(i) + nb_child(i) - 1
-            endif
-!
-        endif
-    enddo
-
-! lubglob contains the global lbound and ubound of the child array
-! lubglob(:,1) : global lbound for each dimension
-! lubglob(:,2) : global lbound for each dimension
-!
-    call Agrif_get_var_global_bounds(child, lubglob, nbdim)
-!
-    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
-    indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2), lubglob(1:nbdim,2))
-!
-    call Agrif_UpdatenD(type_update, parent, child,                         &
-                        indtruetab(1:nbdim,1,1), indtruetab(1:nbdim,1,2),   &
-                        lb_child(1:nbdim), lb_parent(1:nbdim),              &
-                        s_child(1:nbdim), s_parent(1:nbdim),                &
-                        ds_child(1:nbdim), ds_parent(1:nbdim),              &
-#if defined AGRIF_MPI
-                        posvar, do_update,                                  &
-#endif
-                        nbdim, procname)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_UpdateWhole
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_UpdateBcnd
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_UpdateBcnd ( parent, child, uinf, usup,        &
-                              lb_child, lb_parent,              &
-                              nb_child, posvar,                 &
-                              do_update,                        &
-                              s_child,  s_parent,               &
-                              ds_child, ds_parent, nbdim, procname )
-!---------------------------------------------------------------------------------------------------
-#if defined AGRIF_MPI
-    include 'mpif.h'
-#endif
-!
-    type(Agrif_Variable), pointer           :: parent       !< Variable on the parent grid
-    type(Agrif_Variable), pointer           :: child        !< Variable on the child grid
-    integer, dimension(nbdim), intent(in)   :: uinf         !< First positions where interpolations are calculated
-    integer, dimension(nbdim), intent(in)   :: usup         !< Last  positions where interpolations are calculated
-    integer                                 :: nbdim        !< Number of dimensions of the grid variable
-    integer, dimension(nbdim), intent(in)   :: lb_child     !< Index of the first point inside the domain for
-                                                            !!   the parent grid variable
-    integer, dimension(nbdim), intent(in)   :: lb_parent    !< Index of the first point inside the domain for
-                                                            !!   the child grid variable
-    integer, dimension(nbdim), intent(in)   :: nb_child     !< Number of cells of the child grid
-    integer, dimension(nbdim), intent(in)   :: posvar       !< Position of the variable on the cell (1 or 2)
-    logical, dimension(nbdim), intent(in)   :: do_update    !< Indicates if we update for each dimension
-    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
-    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
-    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
-    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
-    procedure()                             :: procname     !< Data recovery procedure
-!
-    integer,dimension(nbdim)     :: type_update ! Type of update (copy or average)
-    integer,dimension(nbdim,2)   :: lubglob
-    integer                      :: i
-    integer,dimension(nbdim,2,2) :: indtab         ! Arrays indicating the limits of the child
-    integer,dimension(nbdim,2,2) :: indtruetab     ! grid variable where boundary conditions are
-    integer,dimension(nbdim,2,2,nbdim)   :: ptres  ! calculated
-    integer                      :: nb, ndir
-    integer :: coeffraf
-!
-    type_update = child % root_var % type_update(1:nbdim)
-!
-    DO i = 1, nbdim
-        coeffraf = nint(ds_parent(i)/ds_child(i))
-        indtab(i,1,1) = lb_child(i) + (uinf(i) + 1) * coeffraf
-        indtab(i,1,2) = lb_child(i) + (usup(i) + 1) * coeffraf
-
-        indtab(i,2,1) = lb_child(i) + nb_child(i) - (usup(i)+1) *  coeffraf
-        indtab(i,2,2) = lb_child(i) + nb_child(i) - (uinf(i)+1) *  coeffraf
-
-        IF (posvar(i) == 1) THEN
-            IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
-                indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
-                indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)
-            ELSE IF (type_update(i) /= Agrif_Update_Copy) THEN
-                indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
-                indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
-            ENDIF
-        ELSE
-            indtab(i,1,1) = indtab(i,1,1) - coeffraf
-            indtab(i,1,2) = indtab(i,1,2) - 1
-            indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
-            IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
-                indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
-                indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
-                indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
-                indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
-            ENDIF
-        ENDIF
-    ENDDO
-!
-    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
-!
-    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),lubglob(1:nbdim,1))
-    indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),lubglob(1:nbdim,1))
-    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),lubglob(1:nbdim,2))
-    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),lubglob(1:nbdim,2))
-!
-    do nb = 1,nbdim
-        if ( do_update(nb) ) then
-            do ndir = 1,2
-                ptres(nb,1,ndir,nb) = indtruetab(nb,ndir,1)
-                ptres(nb,2,ndir,nb) = indtruetab(nb,ndir,2)
-                do i = 1,nbdim
-                    if ( i /= nb ) then
-                        if ( do_update(i) ) then
-                            ptres(i,1,ndir,nb) = indtruetab(i,1,1)
-                            ptres(i,2,ndir,nb) = indtruetab(i,2,2)
-                        else
-                            if (posvar(i) == 1) then
-                                ptres(i,1,ndir,nb) = lb_child(i)
-                                ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i)
-                            else
-                                ptres(i,1,ndir,nb) = lb_child(i)
-                                ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i) - 1
-                            endif
-                        endif
-                    endif
-                enddo
-            enddo
-        endif
-    enddo
-!
-    do nb = 1,nbdim
-        if ( do_update(nb) ) then
-            do ndir = 1,2
-                call Agrif_UpdatenD(type_update, parent, child,             &
-                        ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),  &
-                        lb_child(1:nbdim),lb_parent(1:nbdim),               &
-                        s_child(1:nbdim),s_parent(1:nbdim),                 &
-                        ds_child(1:nbdim),ds_parent(1:nbdim),               &
-#if defined AGRIF_MPI
-                        posvar,do_update,                                   &
-#endif
-                        nbdim,procname,nb,ndir)
-            enddo
-        endif
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_UpdateBcnd
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_UpdatenD
-!
-!> updates a 2D grid variable on the parent grid of the current grid
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_UpdatenD ( type_update, parent, child,     &
-                            pttab, petab,                   &
-                            lb_child, lb_parent,            &
-                            s_child,  s_parent,             &
-                            ds_child, ds_parent,            &
-#if defined AGRIF_MPI
-                            posvar, do_update,              &
-#endif
-                            nbdim, procname, nb, ndir )
-!---------------------------------------------------------------------------------------------------
-#if defined AGRIF_MPI
-    include 'mpif.h'
-#endif
-!
-    integer, dimension(6),     intent(in)   :: type_update  !< Type of update (copy or average)
-    type(Agrif_Variable), pointer           :: parent       !< Variable of the parent grid
-    type(Agrif_Variable), pointer           :: child        !< Variable of the child grid
-    integer,                   intent(in)   :: nbdim
-    integer, dimension(nbdim), intent(in)   :: pttab        !< Index of the first point inside the domain
-    integer, dimension(nbdim), intent(in)   :: petab        !< Index of the first point inside the domain
-    integer, dimension(nbdim), intent(in)   :: lb_child  !< Index of the first point inside the domain for the child
-                                                            !!    grid variable
-    integer, dimension(nbdim), intent(in)   :: lb_parent !< Index of the first point inside the domain for the parent
-                                                            !!    grid variable
-    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
-    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
-    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
-    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
-    procedure()                             :: procname     !< Data recovery procedure
-    integer, optional,         intent(in)   :: nb, ndir
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(nbdim)       :: pttruetab, cetruetab
-#if defined AGRIF_MPI
-    integer, dimension(nbdim)       :: posvar  !< Position of the variable on the cell (1 or 2)
-    logical, dimension(nbdim)       :: do_update
-#endif
-    integer, dimension(nbdim)       :: coords
-    integer, dimension(nbdim)       :: indmin, indmax
-    integer, dimension(nbdim)       :: indminglob, indmaxglob
-    real   , dimension(nbdim)       :: s_Child_temp, s_Parent_temp
-    integer, dimension(nbdim)       :: lowerbound,upperbound
-    integer, dimension(nbdim)       :: pttruetabwhole, cetruetabwhole
-    integer, dimension(nbdim,2,2)   :: childarray
-    integer, dimension(nbdim,2,2)   :: parentarray
-    integer,dimension(nbdim)     :: type_update_temp
-    logical :: memberin, member
-    integer :: nbin, ndirin
-!
-#if defined AGRIF_MPI
-!
-    integer,dimension(nbdim)    :: indminglob2,indmaxglob2
-    logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
-    logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2
-    integer                               :: code, local_proc
-    integer                               :: i,j,k
-    integer, dimension(nbdim,4)           :: tab3
-    integer, dimension(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
-    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t
-    logical :: find_list_update
-    logical, dimension(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
-    logical, dimension(1) :: memberin1
-!
-#endif
-!
-    type(Agrif_Variable), pointer, save :: tempC => NULL()       ! Temporary child grid variable
-    type(Agrif_Variable), pointer, save :: tempP => NULL()       ! Temporary parent grid variable
-    type(Agrif_Variable), pointer, save :: tempCextend => NULL() ! Temporary child
-    type(Agrif_Variable), pointer, save :: tempPextend => NULL() ! Temporary parent
-    type(Agrif_Variable), pointer :: tempP_indic, tempP_average
-    type(Agrif_Variable), pointer :: tempC_indic
-    logical :: compute_average
-    real :: coeff_multi
-    integer :: nb_dimensions
-!
-!   Get local lower and upper bound of the child variable
-    call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
-
-! here pttab and petab corresponds to the (global) indices of the points needed in the update
-! pttruetab and cetruetab contains only indices that are present on the local processor
-!
-    coords = child % root_var % coords
-!
-    call Agrif_Childbounds( nbdim, lowerbound, upperbound, pttab, petab, Agrif_Procrank,    &
-                            coords, pttruetab, cetruetab, memberin )
-    call Agrif_Prtbounds( nbdim, indminglob, indmaxglob, s_Parent_temp, s_Child_temp,       &
-                         s_child, ds_child, s_parent, ds_parent,                            &
-                         pttab, petab, lb_child, lb_parent                                  &
-#if defined AGRIF_MPI
-                       , posvar, type_update, do_update, pttruetabwhole, cetruetabwhole     &
-#endif
-            )
-
-#if defined AGRIF_MPI
-!
-    IF (memberin) THEN
-        call Agrif_GlobalToLocalBounds(childarray,lowerbound,upperbound,    &
-                                       pttruetab,cetruetab, coords,         &
-                                       nbdim, Agrif_Procrank, member)
-    ENDIF
-
-    call Agrif_Prtbounds(nbdim, indmin, indmax,                     &
-                         s_Parent_temp, s_Child_temp,               &
-                         s_child, ds_child, s_parent, ds_parent,    &
-                         pttruetab, cetruetab, lb_child, lb_parent, &
-                         posvar, type_update, do_update,            &
-                         pttruetabwhole, cetruetabwhole)
-!
-#else
-    indmin = indminglob
-    indmax = indmaxglob
-    pttruetabwhole = pttruetab
-    cetruetabwhole = cetruetab
-    childarray(:,1,2) = pttruetab
-    childarray(:,2,2) = cetruetab
-#endif
-
-    IF (.not.present(nb)) THEN
-        nbin=0
-        ndirin=0
-    ELSE
-        nbin = nb
-        ndirin = ndir
-    ENDIF
-
-    IF (memberin) THEN
-!
-        IF ( .not.associated(tempC) )  allocate(tempC)
-!
-        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
-        call Agrif_var_set_array_tozero(tempC,nbdim)
-
-        SELECT CASE (nbdim)
-        CASE(1)
-            CALL procname(tempC%array1,                 &
-                      childarray(1,1,2),childarray(1,2,2),.TRUE.,nbin,ndirin)
-        CASE(2)
-            CALL procname(tempC%array2,                 &
-                      childarray(1,1,2),childarray(1,2,2),  &
-                      childarray(2,1,2),childarray(2,2,2),.TRUE.,nbin,ndirin)
-        CASE(3)
-            CALL procname(tempC%array3,                 &
-                      childarray(1,1,2),childarray(1,2,2),  &
-                      childarray(2,1,2),childarray(2,2,2),  &
-                      childarray(3,1,2),childarray(3,2,2),.TRUE.,nbin,ndirin)
-        CASE(4)
-            CALL procname(tempC%array4,                 &
-                      childarray(1,1,2),childarray(1,2,2),  &
-                      childarray(2,1,2),childarray(2,2,2),  &
-                      childarray(3,1,2),childarray(3,2,2),  &
-                      childarray(4,1,2),childarray(4,2,2),.TRUE.,nbin,ndirin)
-        CASE(5)
-            CALL procname(tempC%array5,                 &
-                      childarray(1,1,2),childarray(1,2,2),  &
-                      childarray(2,1,2),childarray(2,2,2),  &
-                      childarray(3,1,2),childarray(3,2,2),  &
-                      childarray(4,1,2),childarray(4,2,2),  &
-                      childarray(5,1,2),childarray(5,2,2),.TRUE.,nbin,ndirin)
-        CASE(6)
-            CALL procname(tempC%array6,                 &
-                      childarray(1,1,2),childarray(1,2,2),  &
-                      childarray(2,1,2),childarray(2,2,2),  &
-                      childarray(3,1,2),childarray(3,2,2),  &
-                      childarray(4,1,2),childarray(4,2,2),  &
-                      childarray(5,1,2),childarray(5,2,2),  &
-                      childarray(6,1,2),childarray(6,2,2),.TRUE.,nbin,ndirin)
-        END SELECT
-!
-    ENDIF
-!
-#if defined AGRIF_MPI
-!
-!     tab2 contains the necessary limits of the parent grid for each processor
-
-    if (Associated(child%list_update)) then
-        call Agrif_Find_list_update(child%list_update,pttab,petab,                      &
-                                    lb_child,lb_parent,nbdim,                         &
-                                    find_list_update,tab4t,tab5t,memberinall,memberinall2,  &
-                                    sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
-    else
-        find_list_update = .FALSE.
-    endif
-
-    if (.not.find_list_update) then
-        tab3(:,1) = pttruetab(:)
-        tab3(:,2) = cetruetab(:)
-        tab3(:,3) = pttruetabwhole(:)
-        tab3(:,4) = cetruetabwhole(:)
-!
-        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
-
-        if ( .not.associated(tempCextend) ) allocate(tempCextend)
-        do k=0,Agrif_Nbprocs-1
-            do j=1,4
-                do i=1,nbdim
-                    tab4t(i,k,j) = tab4(i,j,k)
-                enddo
-            enddo
-        enddo
-
-        memberin1(1) = memberin
-        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
-
-        call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),tab4t(:,:,3),tab4t(:,:,4),   &
-                                     nbdim, memberinall, coords,                            &
-                                     sendtoproc1,recvfromproc1,                             &
-                                     tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
-    endif
-
-    call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim,         &
-            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),    &
-            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,tempCextend)
-
-#else
-    tempCextend => tempC
-#endif
-!
-!     Update of the parent grid (tempP) from the child grid (tempC)
-!
-    IF (memberin) THEN
-!
-        IF ( .not.associated(tempP) ) allocate(tempP)
-!
-        call Agrif_array_allocate(tempP,indmin,indmax,nbdim)
-!
-        if ( nbdim == 1 ) then
-            tempP % array1 = 0.
-            call Agrif_Update_1D_Recursive( type_update(1),  &
-                                            tempP%array1,   &
-                                            tempCextend%array1, &
-                                            indmin(1), indmax(1),   &
-                                            pttruetabwhole(1), cetruetabwhole(1),   &
-                                            s_Child_temp(1), s_Parent_temp(1),      &
-                                            ds_child(1), ds_parent(1) )
-                                            
-            IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array1),ubound(tempCextend%array1),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array1),ubound(tempP%array1),nbdim)
-
-            compute_average = .FALSE.
-            type_update_temp(1:nbdim) = type_update(1:nbdim)
-            IF (ANY(type_update(1:nbdim) == Agrif_Update_Full_Weighting)) THEN
-              compute_average = .TRUE.
-              allocate(tempP_average)
-              call Agrif_array_allocate(tempP_average,lbound(tempP%array1),ubound(tempP%array1),nbdim)
-              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
-                type_update_temp(1:nbdim) = Agrif_Update_Average
-              END WHERE
-              call Agrif_Update_1D_Recursive( type_update_temp(1),   &
-                                            tempP_average%array1,       &
-                                            tempCextend%array1, &
-                                            indmin(1), indmax(1),   &
-                                            pttruetabwhole(1), cetruetabwhole(1),   &
-                                            s_Child_temp(1), s_Parent_temp(1),      &
-                                            ds_child(1), ds_parent(1) )
-              coeff_multi = 1.
-              do nb_dimensions=1,nbdim
-                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
-              enddo
-            ENDIF
-            
-            WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array1 = 0.
-            ELSEWHERE
-              tempC_indic%array1 = 1.
-            END WHERE
-            
-            Agrif_UseSpecialValueInUpdate = .FALSE.
-            Agrif_Update_Weights = .TRUE.
- 
-             call Agrif_Update_1D_Recursive( type_update_temp(1),   &
-                                            tempP_indic%array1,       &
-                                            tempC_indic%array1, &
-                                            indmin(1), indmax(1),   &
-                                            pttruetabwhole(1), cetruetabwhole(1),   &
-                                            s_Child_temp(1), s_Parent_temp(1),      &
-                                            ds_child(1), ds_parent(1) )
-
-           Agrif_UseSpecialValueInUpdate = .TRUE.
-           Agrif_Update_Weights = .FALSE.
-
-           IF (compute_average) THEN
-               WHERE (tempP_indic%array1 == 0.)
-                  tempP%array1 = Agrif_SpecialValueFineGrid
-               ELSEWHERE ((tempP_indic%array1 == coeff_multi).AND.(tempP%array1 /= Agrif_SpecialValueFineGrid))
-                  tempP%array1 = tempP%array1 /tempP_indic%array1
-               ELSEWHERE
-                  tempP%array1 = tempP_average%array1 /tempP_indic%array1
-               END WHERE
-
-           ELSE
-               WHERE (tempP_indic%array1 == 0.)
-                  tempP%array1 = Agrif_SpecialValueFineGrid
-               ELSEWHERE
-                  tempP%array1 = tempP%array1 /tempP_indic%array1
-               END WHERE
-            ENDIF
-           
-            deallocate(tempP_indic%array1)
-            deallocate(tempC_indic%array1)
-            deallocate(tempC_indic)
-            deallocate(tempP_indic)
-            IF (compute_average) THEN
-              deallocate(tempP_average%array1)
-              deallocate(tempP_average)
-            ENDIF
-            ENDIF
-            
-        endif
-        if ( nbdim == 2 ) then
-            call Agrif_Update_2D_Recursive( type_update(1:2),   &
-                                            tempP%array2,       &
-                                            tempCextend%array2, &
-                                            indmin(1:2), indmax(1:2),   &
-                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
-                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
-                                            ds_child(1:2), ds_parent(1:2) )
-
-            IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array2),ubound(tempCextend%array2),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array2),ubound(tempP%array2),nbdim)
- 
-            compute_average = .FALSE.
-            type_update_temp(1:nbdim) = type_update(1:nbdim)
-            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
-              compute_average = .TRUE.
-              allocate(tempP_average)
-              call Agrif_array_allocate(tempP_average,lbound(tempP%array2),ubound(tempP%array2),nbdim)
-              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
-                type_update_temp(1:nbdim) = Agrif_Update_Average
-              END WHERE
-              call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
-                                            tempP_average%array2,       &
-                                            tempCextend%array2, &
-                                            indmin(1:2), indmax(1:2),   &
-                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
-                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
-                                            ds_child(1:2), ds_parent(1:2) )
-              coeff_multi = 1.
-              do nb_dimensions=1,nbdim
-                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
-              enddo
-            ENDIF
-            
-            WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array2 = 0.
-            ELSEWHERE
-              tempC_indic%array2 = 1.
-            END WHERE
-            
-            Agrif_UseSpecialValueInUpdate = .FALSE.
-            Agrif_Update_Weights = .TRUE.
-            
-            call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
-                                            tempP_indic%array2,       &
-                                            tempC_indic%array2, &
-                                            indmin(1:2), indmax(1:2),   &
-                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
-                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
-                                            ds_child(1:2), ds_parent(1:2) )
-
-           Agrif_UseSpecialValueInUpdate = .TRUE.
-           Agrif_Update_Weights = .FALSE.
-
-           IF (compute_average) THEN
-               WHERE (tempP_indic%array2 == 0.)
-                  tempP%array2 = Agrif_SpecialValueFineGrid
-               ELSEWHERE ((tempP_indic%array2 == coeff_multi).AND.(tempP%array2 /= Agrif_SpecialValueFineGrid))
-                  tempP%array2 = tempP%array2 /tempP_indic%array2
-               ELSEWHERE
-                  tempP%array2 = tempP_average%array2 /tempP_indic%array2
-               END WHERE
-
-           ELSE
-               WHERE (tempP_indic%array2 == 0.)
-                  tempP%array2 = Agrif_SpecialValueFineGrid
-               ELSEWHERE
-                  tempP%array2 = tempP%array2 /tempP_indic%array2
-               END WHERE
-            ENDIF
-           
-            deallocate(tempP_indic%array2)
-            deallocate(tempC_indic%array2)
-            deallocate(tempC_indic)
-            deallocate(tempP_indic)
-            IF (compute_average) THEN
-              deallocate(tempP_average%array2)
-              deallocate(tempP_average)
-            ENDIF
-            ENDIF
-            
-        endif
-        if ( nbdim == 3 ) then
-            call Agrif_Update_3D_Recursive( type_update(1:3),   &
-                                            tempP%array3,       &
-                                            tempCextend%array3, &
-                                            indmin(1:3), indmax(1:3),   &
-                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
-                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
-                                            ds_child(1:3), ds_parent(1:3) )
-                                            
-            IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array3),ubound(tempCextend%array3),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array3),ubound(tempP%array3),nbdim)
-
-            compute_average = .FALSE.
-            type_update_temp(1:nbdim) = type_update(1:nbdim)
-            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
-              compute_average = .TRUE.
-              allocate(tempP_average)
-              call Agrif_array_allocate(tempP_average,lbound(tempP%array3),ubound(tempP%array3),nbdim)
-              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
-                type_update_temp(1:nbdim) = Agrif_Update_Average
-              END WHERE
-              call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
-                                            tempP_average%array3,       &
-                                            tempCextend%array3, &
-                                            indmin(1:3), indmax(1:3),   &
-                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
-                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
-                                            ds_child(1:3), ds_parent(1:3) )
-              coeff_multi = 1.
-              do nb_dimensions=1,nbdim
-                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
-              enddo
-            ENDIF
-            
-            WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array3 = 0.
-            ELSEWHERE
-              tempC_indic%array3 = 1.
-            END WHERE
-            
-            Agrif_UseSpecialValueInUpdate = .FALSE.
-            Agrif_Update_Weights = .TRUE.
- 
-             call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
-                                            tempP_indic%array3,       &
-                                            tempC_indic%array3, &
-                                            indmin(1:3), indmax(1:3),   &
-                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
-                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
-                                            ds_child(1:3), ds_parent(1:3) )
-
-           Agrif_UseSpecialValueInUpdate = .TRUE.
-           Agrif_Update_Weights = .FALSE.
-
-           IF (compute_average) THEN
-               WHERE (tempP_indic%array3 == 0.)
-                  tempP%array3 = Agrif_SpecialValueFineGrid
-               ELSEWHERE ((tempP_indic%array3 == coeff_multi).AND.(tempP%array3 /= Agrif_SpecialValueFineGrid))
-                  tempP%array3 = tempP%array3 /tempP_indic%array3
-               ELSEWHERE
-                  tempP%array3 = tempP_average%array3 /tempP_indic%array3
-               END WHERE
-
-           ELSE
-               WHERE (tempP_indic%array3 == 0.)
-                  tempP%array3 = Agrif_SpecialValueFineGrid
-               ELSEWHERE
-                  tempP%array3 = tempP%array3 /tempP_indic%array3
-               END WHERE
-            ENDIF
-           
-            deallocate(tempP_indic%array3)
-            deallocate(tempC_indic%array3)
-            deallocate(tempC_indic)
-            deallocate(tempP_indic)
-            IF (compute_average) THEN
-              deallocate(tempP_average%array3)
-              deallocate(tempP_average)
-            ENDIF
-            ENDIF
-            
-        endif
-        if ( nbdim == 4 ) then
-            call Agrif_Update_4D_Recursive( type_update(1:4),   &
-                                            tempP%array4,       &
-                                            tempCextend%array4, &
-                                            indmin(1:4), indmax(1:4),   &
-                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
-                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
-                                            ds_child(1:4), ds_parent(1:4) )
-                                            
-            IF (Agrif_UseSpecialValueInUpdate) THEN
-            
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array4),ubound(tempCextend%array4),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array4),ubound(tempP%array4),nbdim)
-           
-            compute_average = .FALSE.
-            type_update_temp(1:nbdim) = type_update(1:nbdim)
-            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
-              compute_average = .TRUE.
-              allocate(tempP_average)
-              call Agrif_array_allocate(tempP_average,lbound(tempP%array4),ubound(tempP%array4),nbdim)
-              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
-                type_update_temp(1:nbdim) = Agrif_Update_Average
-              END WHERE
-              call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
-                                            tempP_average%array4,       &
-                                            tempCextend%array4, &
-                                            indmin(1:4), indmax(1:4),   &
-                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
-                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
-                                            ds_child(1:4), ds_parent(1:4) )
-              coeff_multi = 1.
-              do nb_dimensions=1,nbdim
-                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
-              enddo
-            ENDIF
-            
-            WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array4 = 0.
-            ELSEWHERE
-              tempC_indic%array4 = 1.
-            END WHERE
-            
-            Agrif_UseSpecialValueInUpdate = .FALSE.
-            Agrif_Update_Weights = .TRUE.
- 
-             call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
-                                            tempP_indic%array4,       &
-                                            tempC_indic%array4, &
-                                            indmin(1:4), indmax(1:4),   &
-                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
-                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
-                                            ds_child(1:4), ds_parent(1:4) )
-
-           Agrif_UseSpecialValueInUpdate = .TRUE.
-           Agrif_Update_Weights = .FALSE.
-           
-           IF (compute_average) THEN
-               WHERE (tempP_indic%array4 == 0.)
-                  tempP%array4 = Agrif_SpecialValueFineGrid
-               ELSEWHERE ((tempP_indic%array4 == coeff_multi).AND.(tempP%array4 /= Agrif_SpecialValueFineGrid))
-                  tempP%array4 = tempP%array4 /tempP_indic%array4
-               ELSEWHERE
-                  tempP%array4 = tempP_average%array4 /tempP_indic%array4
-               END WHERE
-
-           ELSE
-               WHERE (tempP_indic%array4 == 0.)
-                  tempP%array4 = Agrif_SpecialValueFineGrid
-               ELSEWHERE
-                  tempP%array4 = tempP%array4 /tempP_indic%array4
-               END WHERE
-            ENDIF
-            deallocate(tempP_indic%array4)
-            deallocate(tempC_indic%array4)
-            deallocate(tempC_indic)
-            deallocate(tempP_indic)
-            IF (compute_average) THEN
-              deallocate(tempP_average%array4)
-              deallocate(tempP_average)
-            ENDIF
-            ENDIF
-            
-        endif
-        if ( nbdim == 5 ) then
-            call Agrif_Update_5D_Recursive( type_update(1:5),   &
-                                            tempP%array5,       &
-                                            tempCextend%array5, &
-                                            indmin(1:5), indmax(1:5),   &
-                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
-                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
-                                            ds_child(1:5), ds_parent(1:5) )
-                                            
-            IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array5),ubound(tempCextend%array5),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array5),ubound(tempP%array5),nbdim)
-
-            compute_average = .FALSE.
-            type_update_temp(1:nbdim) = type_update(1:nbdim)
-            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
-              compute_average = .TRUE.
-              allocate(tempP_average)
-              call Agrif_array_allocate(tempP_average,lbound(tempP%array5),ubound(tempP%array5),nbdim)
-              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
-                type_update_temp(1:nbdim) = Agrif_Update_Average
-              END WHERE
-              call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
-                                            tempP_average%array5,       &
-                                            tempCextend%array5, &
-                                            indmin(1:5), indmax(1:5),   &
-                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
-                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
-                                            ds_child(1:5), ds_parent(1:5) )
-              coeff_multi = 1.
-              do nb_dimensions=1,nbdim
-                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
-              enddo
-            ENDIF
-            
-            WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array5 = 0.
-            ELSEWHERE
-              tempC_indic%array5 = 1.
-            END WHERE
-            
-            Agrif_UseSpecialValueInUpdate = .FALSE.
-            Agrif_Update_Weights = .TRUE.
- 
-             call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
-                                            tempP_indic%array5,       &
-                                            tempC_indic%array5, &
-                                            indmin(1:5), indmax(1:5),   &
-                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
-                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
-                                            ds_child(1:5), ds_parent(1:5) )
-
-           Agrif_UseSpecialValueInUpdate = .TRUE.
-           Agrif_Update_Weights = .FALSE.
-
-           IF (compute_average) THEN
-               WHERE (tempP_indic%array5 == 0.)
-                  tempP%array5 = Agrif_SpecialValueFineGrid
-               ELSEWHERE ((tempP_indic%array5 == coeff_multi).AND.(tempP%array5 /= Agrif_SpecialValueFineGrid))
-                  tempP%array5 = tempP%array5 /tempP_indic%array5
-               ELSEWHERE
-                  tempP%array5 = tempP_average%array5 /tempP_indic%array5
-               END WHERE
-
-           ELSE
-               WHERE (tempP_indic%array5 == 0.)
-                  tempP%array5 = Agrif_SpecialValueFineGrid
-               ELSEWHERE
-                  tempP%array5 = tempP%array5 /tempP_indic%array5
-               END WHERE
-            ENDIF
-           
-            deallocate(tempP_indic%array5)
-            deallocate(tempC_indic%array5)
-            deallocate(tempC_indic)
-            deallocate(tempP_indic)
-            IF (compute_average) THEN
-              deallocate(tempP_average%array5)
-              deallocate(tempP_average)
-            ENDIF
-            ENDIF
-            
-        endif
-        if ( nbdim == 6 ) then
-            call Agrif_Update_6D_Recursive( type_update(1:6),   &
-                                            tempP%array6,       &
-                                            tempCextend%array6, &
-                                            indmin(1:6), indmax(1:6),   &
-                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
-                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
-                                            ds_child(1:6), ds_parent(1:6) )
-            IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array6),ubound(tempCextend%array6),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array6),ubound(tempP%array6),nbdim)
-
-            compute_average = .FALSE.
-            type_update_temp(1:nbdim) = type_update(1:nbdim)
-            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
-              compute_average = .TRUE.
-              allocate(tempP_average)
-              call Agrif_array_allocate(tempP_average,lbound(tempP%array6),ubound(tempP%array6),nbdim)
-              type_update_temp(1:nbdim) = type_update
-              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
-                type_update_temp(1:nbdim) = Agrif_Update_Average
-              END WHERE
-              call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
-                                            tempP_average%array6,       &
-                                            tempCextend%array6, &
-                                            indmin(1:6), indmax(1:6),   &
-                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
-                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
-                                            ds_child(1:6), ds_parent(1:6) )
-              coeff_multi = 1.
-              do nb_dimensions=1,nbdim
-                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
-              enddo
-            ENDIF
-
-           IF (compute_average) THEN
-               WHERE (tempP_indic%array6 == 0.)
-                  tempP%array6 = Agrif_SpecialValueFineGrid
-               ELSEWHERE ((tempP_indic%array6 == coeff_multi).AND.(tempP%array6 /= Agrif_SpecialValueFineGrid))
-                  tempP%array6 = tempP%array6 /tempP_indic%array6
-               ELSEWHERE
-                  tempP%array6 = tempP_average%array6 /tempP_indic%array6
-               END WHERE
-
-           ELSE
-               WHERE (tempP_indic%array6 == 0.)
-                  tempP%array6 = Agrif_SpecialValueFineGrid
-               ELSEWHERE
-                  tempP%array6 = tempP%array6 /tempP_indic%array6
-               END WHERE
-            ENDIF
-            
-            Agrif_UseSpecialValueInUpdate = .FALSE.
-            Agrif_Update_Weights = .TRUE.
- 
-             call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
-                                            tempP_indic%array6,       &
-                                            tempC_indic%array6, &
-                                            indmin(1:6), indmax(1:6),   &
-                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
-                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
-                                            ds_child(1:6), ds_parent(1:6) )
-
-           Agrif_UseSpecialValueInUpdate = .TRUE.
-           Agrif_Update_Weights = .FALSE.
-           
-            WHERE (tempP_indic%array6 == 0.)
-              tempP%array6 = Agrif_SpecialValueFineGrid
-            ELSEWHERE
-              tempP%array6 = tempP%array6 /tempP_indic%array6
-            END WHERE
-           
-            deallocate(tempP_indic%array6)
-            deallocate(tempC_indic%array6)
-            deallocate(tempC_indic)
-            deallocate(tempP_indic)
-            IF (compute_average) THEN
-              deallocate(tempP_average%array6)
-              deallocate(tempP_average)
-            ENDIF
-            ENDIF
-        endif
-!
-        call Agrif_array_deallocate(tempCextend,nbdim)
-!
-    ENDIF
-
-#if defined AGRIF_MPI
-    local_proc = Agrif_Procrank
-    call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
-    call Agrif_ChildGrid_to_ParentGrid()
-    call Agrif_Childbounds(nbdim, lowerbound, upperbound,                   &
-                           indminglob,  indmaxglob,  local_proc, coords,    &
-                           indminglob2, indmaxglob2, member)
-!
-    IF (member) THEN
-        call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, &
-                                       indminglob2, indmaxglob2, coords,    &
-                                       nbdim, local_proc, member)
-    ENDIF
-
-    call Agrif_ParentGrid_to_ChildGrid()
-
-    if (.not.find_list_update) then
-        tab3(:,1) = indmin(:)
-        tab3(:,2) = indmax(:)
-        tab3(:,3) = indminglob2(:)
-        tab3(:,4) = indmaxglob2(:)
-!
-        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
-
-        IF ( .not.associated(tempPextend) ) allocate(tempPextend)
-        DO k=0,Agrif_Nbprocs-1
-            do j=1,4
-                do i=1,nbdim
-                    tab5t(i,k,j) = tab4(i,j,k)
-                enddo
-            enddo
-        enddo
-
-        memberin1(1) = member
-        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,1,MPI_LOGICAL,Agrif_mpi_comm,code)
-        call Get_External_Data_first(tab5t(:,:,1),tab5t(:,:,2),tab5t(:,:,3),tab5t(:,:,4),   &
-                                     nbdim, memberinall2, coords,                           &
-                                     sendtoproc2, recvfromproc2,                            &
-                                     tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
-
-        call Agrif_Addto_list_update(child%list_update,pttab,petab,lb_child,lb_parent,      &
-                                     nbdim,tab4t,tab5t,memberinall,memberinall2,            &
-                                     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
-
-    endif
-
-    call ExchangeSameLevel(sendtoproc2,recvfromproc2,nbdim,                     &
-                            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),&
-                            tab5t(:,:,7),tab5t(:,:,8),member,tempP,tempPextend)
-#else
-    tempPextend => tempP
-    parentarray(:,1,1) = indmin
-    parentarray(:,2,1) = indmax
-    parentarray(:,1,2) = indmin
-    parentarray(:,2,2) = indmax
-    member = .TRUE.
-#endif
-!
-!   Special values on the child grid
-    if ( Agrif_UseSpecialValueFineGrid ) then
-!
-!cc         noraftab(1:nbdim) =
-!cc     &    child % root_var % interptab(1:nbdim) == 'N'
-!
-#if defined AGRIF_MPI
-!
-!          allocate(childvalues% var)
-!
-!          Call Agrif_array_allocate(childvalues%var,
-!     &                      pttruetab,cetruetab,nbdim)
-!          Call Agrif_var_full_copy_array(childvalues% var,
-!     &                                tempC,
-!     &                                nbdim)
-!          Call Agrif_CheckMasknD(tempC,childvalues,
-!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-!     &                           noraftab(1:nbdim),nbdim)
-!          Call Agrif_array_deallocate(childvalues% var,nbdim)
-!         Deallocate(childvalues % var)
-!
-#else
-!
-!          Call Agrif_get_var_bounds_array(child,
-!     &                              lowerbound,upperbound,nbdim)
-!          Call Agrif_CheckMasknD(tempC,child,
-!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-!     &                           lowerbound,
-!     &                           upperbound,
-!     &                           noraftab(1:nbdim),nbdim)
-!
-#endif
-!
-    endif
-!
-!   Special values on the parent grid
-    if (Agrif_UseSpecialValue) then
-!
-#if defined AGRIF_MPI
-!
-!          Call GiveAgrif_SpecialValueToTab_mpi(parent,tempP,
-!     &                 parentarray,
-!     &                 Agrif_SpecialValue,nbdim)
-!
-!
-#else
-!
-!          Call GiveAgrif_SpecialValueToTab(parent,tempP,
-!     &                  indmin,indmax,
-!     &                  Agrif_SpecialValue,nbdim)
-!
-#endif
-!
-    endif
-!
-    IF (member) THEN
-
-        call Agrif_ChildGrid_to_ParentGrid()
-!
-        SELECT CASE(nbdim)
-        CASE(1)
-            call procname( tempPextend % array1(            &
-                    parentarray(1,1,1):parentarray(1,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin)
-        CASE(2)
-            call procname( tempPextend % array2(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),.FALSE.,nbin,ndirin)
-        CASE(3)
-            call procname( tempPextend % array3(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1),  &
-                    parentarray(3,1,1):parentarray(3,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),  &
-                    parentarray(3,1,2),parentarray(3,2,2),.FALSE.,nbin,ndirin)
-        CASE(4)
-            call procname( tempPextend % array4(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1),  &
-                    parentarray(3,1,1):parentarray(3,2,1),  &
-                    parentarray(4,1,1):parentarray(4,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),  &
-                    parentarray(3,1,2),parentarray(3,2,2),  &
-                    parentarray(4,1,2),parentarray(4,2,2),.FALSE.,nbin,ndirin)
-        CASE(5)
-            call procname( tempPextend % array5(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1),  &
-                    parentarray(3,1,1):parentarray(3,2,1),  &
-                    parentarray(4,1,1):parentarray(4,2,1),  &
-                    parentarray(5,1,1):parentarray(5,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),  &
-                    parentarray(3,1,2),parentarray(3,2,2),  &
-                    parentarray(4,1,2),parentarray(4,2,2),  &
-                    parentarray(5,1,2),parentarray(5,2,2),.FALSE.,nbin,ndirin)
-        CASE(6)
-            call procname( tempPextend % array6(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1),  &
-                    parentarray(3,1,1):parentarray(3,2,1),  &
-                    parentarray(4,1,1):parentarray(4,2,1),  &
-                    parentarray(5,1,1):parentarray(5,2,1),  &
-                    parentarray(6,1,1):parentarray(6,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),  &
-                    parentarray(3,1,2),parentarray(3,2,2),  &
-                    parentarray(4,1,2),parentarray(4,2,2),  &
-                    parentarray(5,1,2),parentarray(5,2,2),  &
-                    parentarray(6,1,2),parentarray(6,2,2),.FALSE.,nbin,ndirin)
-        END SELECT
-!
-        call Agrif_ParentGrid_to_ChildGrid()
-!
-        call Agrif_array_deallocate(tempPextend,nbdim)
-!
-    ENDIF
-!
-#if defined AGRIF_MPI
-    IF (memberin) THEN
-        call Agrif_array_deallocate(tempP,nbdim)
-        call Agrif_array_deallocate(tempC,nbdim)
-    ENDIF
-#endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_UpdatenD
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Prtbounds
-!
-!> calculates the bounds of the parent grid to be updated by the child grid
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Prtbounds ( nbdim, indmin, indmax, s_Parent_temp, s_Child_temp,        &
-                             s_child, ds_child, s_parent, ds_parent,                    &
-                             pttruetab, cetruetab, lb_child, lb_parent            &
-#if defined AGRIF_MPI
-                            ,posvar, type_update, do_update,                &
-                             pttruetabwhole, cetruetabwhole                             &
-#endif
-                )
-!---------------------------------------------------------------------------------------------------
-    integer,                   intent(in)   :: nbdim
-    integer, dimension(nbdim), intent(out)  :: indmin, indmax
-    real,    dimension(nbdim), intent(out)  :: s_Parent_temp, s_Child_temp
-    real,    dimension(nbdim), intent(in)   :: s_child,  ds_child
-    real,    dimension(nbdim), intent(in)   :: s_parent, ds_parent
-    integer, dimension(nbdim), intent(in)   :: pttruetab, cetruetab
-    integer, dimension(nbdim), intent(in)   :: lb_child, lb_parent
-#if defined AGRIF_MPI
-    integer, dimension(nbdim), intent(in)   :: posvar   !< Position of the variable on the cell (1 or 2)
-    integer, dimension(nbdim), intent(in)   :: type_update
-    logical, dimension(nbdim), intent(in)   :: do_update
-    integer,dimension(nbdim), intent(out)   :: pttruetabwhole, cetruetabwhole
-#endif
-!
-    real,dimension(nbdim) :: dim_newmin,dim_newmax
-    integer :: i
-#if defined AGRIF_MPI
-    real    :: positionmin, positionmax
-    integer :: imin, imax
-    integer :: coeffraf
-#endif
-!
-    do i = 1,nbdim
-!
-        dim_newmin(i) = s_child(i) + (pttruetab(i) - lb_child(i)) * ds_child(i)
-        dim_newmax(i) = s_child(i) + (cetruetab(i) - lb_child(i)) * ds_child(i)
-!
-        indmin(i) = lb_parent(i) + agrif_ceiling((dim_newmin(i)-s_parent(i))/ds_parent(i))
-        indmax(i) = lb_parent(i) + agrif_int(    (dim_newmax(i)-s_parent(i))/ds_parent(i))
-!
-#if defined AGRIF_MPI
-        positionmin = s_parent(i) + (indmin(i)-lb_parent(i))*ds_parent(i)
-        IF ( do_update(i) ) THEN
-            IF (posvar(i) == 1) THEN
-                IF      (type_update(i) == Agrif_Update_Average) THEN
-                    positionmin = positionmin - ds_parent(i)/2.
-                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
-                    positionmin = positionmin - (ds_parent(i)-ds_child(i))
-                ENDIF
-            ELSE
-                IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN
-                    positionmin = positionmin - ds_parent(i)/2.
-                ELSE
-                    coeffraf = nint(ds_parent(i)/ds_child(i))
-                    if (mod(coeffraf,2) == 1) then
-                        positionmin = positionmin - (ds_parent(i)-ds_child(i))
-                    else
-                        positionmin = positionmin - (ds_parent(i)-ds_child(i))-ds_child(i)/2.
-                    endif
-                ENDIF
-            ENDIF
-        ENDIF
-!
-        imin = lb_child(i) + agrif_ceiling((positionmin-s_child(i))/ds_child(i))
-        positionmin = s_child(i)  + (imin - lb_child(i)) * ds_child(i)
-        positionmax = s_parent(i) + (indmax(i)-lb_parent(i))*ds_parent(i)
-        pttruetabwhole(i) = imin
-
-        IF ( do_update(i) ) THEN
-            IF (posvar(i) == 1) THEN
-                IF      (type_update(i) == Agrif_Update_Average) THEN
-                    positionmax = positionmax  + ds_parent(i)/2.
-                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
-                    positionmax = positionmax  + (ds_parent(i)-ds_child(i))
-                ENDIF
-            ELSE
-                IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN
-                    positionmax = positionmax  + ds_parent(i)/2.
-                ELSE
-                    coeffraf = nint(ds_parent(i)/ds_child(i))
-                    if (mod(coeffraf,2) == 1) then
-                        positionmax = positionmax + (ds_parent(i)-ds_child(i))
-                    else
-                        positionmax = positionmax + (ds_parent(i)-ds_child(i)) + ds_child(i)/2.
-                    endif
-                ENDIF
-            ENDIF
-        ENDIF
-
-        imax = lb_child(i) +agrif_int((positionmax-s_child(i))/ds_child(i))
-        positionmax = s_child(i) + (imax - lb_child(i)) * ds_child(i)
-        cetruetabwhole(i) = imax
-#endif
-!
-        s_Parent_temp(i) = s_parent(i) + (indmin(i) - lb_parent(i)) * ds_parent(i)
-        s_Child_temp(i)  = dim_newmin(i)
-
-#if defined AGRIF_MPI
-        s_Child_temp(i) = positionmin
-#endif
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Prtbounds
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Update_1D_Recursive
-!
-!> Updates a 1D grid variable on the parent grid
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_1D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                       s_child,  s_parent,  &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer,                            intent(in)  :: type_update            !< Type of update (copy or average)
-    integer,                            intent(in)  :: indmin, indmax
-    integer,                            intent(in)  :: lb_child, ub_child
-    real,                               intent(in)  ::  s_child,  s_parent
-    real,                               intent(in)  :: ds_child, ds_parent
-    real, dimension(indmin:indmax),     intent(out) :: tempP
-    real, dimension(lb_child:ub_child), intent(in)  :: tempC
-!---------------------------------------------------------------------------------------------------
-    call Agrif_UpdateBase(type_update,              &
-                          tempP(indmin:indmax),     &
-                          tempC(lb_child:ub_child), &
-                          indmin, indmax,           &
-                          lb_child, ub_child,       &
-                          s_parent, s_child,        &
-                          ds_parent, ds_child)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_1D_Recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Update_2D_Recursive
-!
-!> updates a 2D grid variable on the parent grid.
-!! Calls #Agrif_Update_1D_Recursive and #Agrif_UpdateBase
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_2D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(2),          intent(in)  :: type_update            !< Type of update (copy or average)
-    integer, dimension(2),          intent(in)  :: indmin, indmax
-    integer, dimension(2),          intent(in)  :: lb_child, ub_child
-    real,    dimension(2),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(2),          intent(in)  :: ds_child, ds_parent
-    real,    dimension(          &
-        indmin(1):indmax(1),     &
-        indmin(2):indmax(2)),       intent(out) :: tempP
-    real,    dimension(:,:),        intent(in)  :: tempC
-!---------------------------------------------------------------------------------------------------
-    real, dimension(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
-    real, dimension(indmin(2):indmax(2), indmin(1):indmax(1))     :: tempP_trsp
-    real, dimension(lb_child(2):ub_child(2), indmin(1):indmax(1)) :: tabtemp_trsp
-    integer :: i, j
-    integer :: coeffraf
-!
-    tabtemp = 0.
-    coeffraf = nint ( ds_parent(1) / ds_child(1) )
-!
-    IF((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN
-!---CDIR NEXPAND
-        if ( .NOT. precomputedone(1) ) then
-            call Average1dPrecompute( ub_child(2)-lb_child(2)+1,    &
-                                      indmax(1)-indmin(1)+1,              &
-                                      ub_child(1)-lb_child(1)+1,    &
-                                      s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!            precomputedone(1) = .TRUE.
-        endif
-!---CDIR NEXPAND
-        call Average1dAfterCompute( tabtemp, tempC, size(tabtemp), size(tempC), &
-                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!
-    ELSE IF ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         if ( .NOT. precomputedone(1) ) then
-            call Agrif_basicupdate_copy1d_before( ub_child(2)-lb_child(2)+1, &
-                                   indmax(1)-indmin(1)+1,           &
-                                   ub_child(1)-lb_child(1)+1, &
-                                   s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!            precomputedone(1) = .TRUE.
-        endif
-!---CDIR NEXPAND
-        call Agrif_basicupdate_copy1d_after(tabtemp,tempC,size(tabtemp),size(tempC),1)
-!
-    ELSE
-        do j = lb_child(2),ub_child(2)
-!
-!---CDIR NEXPAND
-            call Agrif_Update_1D_Recursive( type_update(1),             &
-                                            tabtemp(:,j),               &
-                                            tempC(:,j-lb_child(2)+1),   &
-                                            indmin(1), indmax(1),       &
-                                            lb_child(1),ub_child(1),    &
-                                            s_child(1),  s_parent(1),   &
-                                            ds_child(1),ds_parent(1))
-        enddo
-    ENDIF
-!
-    tabtemp_trsp = TRANSPOSE(tabtemp)
-    coeffraf = nint(ds_parent(2)/ds_child(2))
-!
-    tempP_trsp = 0.
-!
-    IF((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN
-!---CDIR NEXPAND
-        if ( .NOT. precomputedone(2) ) then
-            call Average1dPrecompute( indmax(1)-indmin(1)+1,          &
-                                      indmax(2)-indmin(2)+1,          &
-                                      ub_child(2)-lb_child(2)+1,&
-                                      s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!            precomputedone(2) = .TRUE.
-        endif
-!---CDIR NEXPAND
-        call Average1dAfterCompute( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),&
-                s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!
-    ELSE IF ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) THEN
-!---CDIR NEXPAND
-        if ( .NOT. precomputedone(2) ) then
-            call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1,             &
-                                   indmax(2)-indmin(2)+1,             &
-                                   ub_child(2)-lb_child(2)+1,   &
-                                   s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!            precomputedone(2) = .TRUE.
-        endif
-!---CDIR NEXPAND
-        call Agrif_basicupdate_copy1d_after( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),2)
-!
-    ELSE
-        do i = indmin(1),indmax(1)
-!
-!---CDIR NEXPAND
-            call Agrif_UpdateBase(type_update(2),                                       &
-                                  tempP_trsp(indmin(2):indmax(2),i),            &
-                                  tabtemp_trsp(lb_child(2):ub_child(2),i),&
-                                  indmin(2),indmax(2),                          &
-                                  lb_child(2),ub_child(2),                &
-                                  s_parent(2),s_child(2),                       &
-                                  ds_parent(2),ds_child(2))
-!
-        enddo
-    ENDIF
-!
-    tempP = TRANSPOSE(tempP_trsp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_2D_Recursive
-!===================================================================================================
-!
-subroutine Agrif_Update_2D_Recursive_ok ( type_update, &
-                                        tempP, tempC, &
-                                        indmin, indmax,   &
-                                       lb_child, ub_child,                    &
-                                       s_child, s_parent, ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    INTEGER, DIMENSION(2), intent(in)   :: type_update            !< Type of update (copy or average)
-    INTEGER, DIMENSION(2), intent(in)   :: indmin, indmax
-    INTEGER, DIMENSION(2), intent(in)   :: lb_child, ub_child
-    REAL,    DIMENSION(2), intent(in)   :: s_child,  s_parent
-    REAL,    DIMENSION(2), intent(in)   :: ds_child, ds_parent
-    REAL,    DIMENSION(                 &
-                indmin(1):indmax(1),    &
-                indmin(2):indmax(2)),           intent(out) :: tempP
-    REAL, DIMENSION(                            &
-                lb_child(1):ub_child(1),  &
-                lb_child(2):ub_child(2)), intent(in)  :: tempC
-!
-    REAL, DIMENSION(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
-    INTEGER :: i
-!
-    do i = lb_child(2),ub_child(2)
-        call Agrif_Update_1D_Recursive(type_update(1),                              &
-                                       tabtemp(:, i),          &
-                                       tempC(:,i),  &
-                                       indmin(1),indmax(1),                 &
-                                       lb_child(1),ub_child(1),       &
-                                       s_child(1), s_parent(1),             &
-                                      ds_child(1),ds_parent(1))
-    enddo
-!
-    tempP = 0.
-!
-    do i = indmin(1),indmax(1)
-        call Agrif_UpdateBase(type_update(2),                                       &
-                              tempP(i,:),             &
-                              tabtemp(i,:), &
-                              indmin(2),indmax(2),                          &
-                              lb_child(2),ub_child(2),                &
-                              s_parent(2),s_child(2),                       &
-                             ds_parent(2),ds_child(2))
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_2D_Recursive_ok
-!===================================================================================================
-
-!
-!===================================================================================================
-!  subroutine Agrif_Update_3D_Recursive
-!
-!> Updates a 3D grid variable on the parent grid.
-!! Calls #Agrif_Update_2D_Recursive and #Agrif_UpdateBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_3D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(3),          intent(in)  :: type_update            !< Type of update (copy or average)
-    integer, dimension(3),          intent(in)  :: indmin, indmax
-    integer, dimension(3),          intent(in)  :: lb_child, ub_child
-    real,    dimension(3),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(3),          intent(in)  :: ds_child, ds_parent
-    real,    dimension(          &
-        indmin(1):indmax(1),     &
-        indmin(2):indmax(2),     &
-        indmin(3):indmax(3)),       intent(out) :: tempP
-    real, dimension(             &
-        lb_child(1):ub_child(1), &
-        lb_child(2):ub_child(2), &
-        lb_child(3):ub_child(3)),   intent(in)  :: tempC
-!---------------------------------------------------------------------------------------------------
-    real, dimension(            &
-        indmin(1):indmax(1),    &
-        indmin(2):indmax(2),    &
-        lb_child(3):ub_child(3))    :: tabtemp
-    integer :: i,j,k
-    integer :: coeffraf,locind_child_left
-    integer :: kuinf
-!
-    coeffraf = nint ( ds_parent(1) / ds_child(1) )
-!
-    if ((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then
-!---CDIR NEXPAND
-        call Average1dPrecompute(ub_child(2)-lb_child(2)+1,&
-                                 indmax(1)-indmin(1)+1,&
-                                 ub_child(1)-lb_child(1)+1,&
-                                 s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-        precomputedone(1) = .TRUE.
-    else if ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then
-!---CDIR NEXPAND
-         call Agrif_basicupdate_copy1d_before(ub_child(2)-lb_child(2)+1, &
-                               indmax(1)-indmin(1)+1,           &
-                               ub_child(1)-lb_child(1)+1, &
-                               s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-        precomputedone(1) = .TRUE.
-    endif
-!
-    coeffraf = nint ( ds_parent(2) / ds_child(2) )
-!
-    if ((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then
-!---CDIR NEXPAND
-        call Average1dPrecompute(indmax(1)-indmin(1)+1,&
-                                 indmax(2)-indmin(2)+1,&
-                                 ub_child(2)-lb_child(2)+1,&
-                                 s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-        precomputedone(2) = .TRUE.
-    else if ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then
-!---CDIR NEXPAND
-        call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1,           &
-                               indmax(2)-indmin(2)+1,           &
-                               ub_child(2)-lb_child(2)+1, &
-                               s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-        precomputedone(2) = .TRUE.
-    endif
-!
-    do k = lb_child(3),ub_child(3)
-        call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), &
-                                        indmin(1:2),indmax(1:2),                &
-                                        lb_child(1:2),ub_child(1:2),      &
-                                        s_child(1:2),s_parent(1:2),             &
-                                        ds_child(1:2),ds_parent(1:2) )
-    enddo
-!
-    precomputedone(1) = .FALSE.
-    precomputedone(2) = .FALSE.
-!
-    coeffraf = nint ( ds_parent(3) / ds_child(3) )
-    locind_child_left = 1 + agrif_int((s_parent(3)-s_child(3))/ds_child(3))
-!
-    if (coeffraf == 1) then
-        kuinf = lb_child(3)+locind_child_left-2
-        do k=indmin(3),indmax(3)
-            kuinf = kuinf + 1
-            do j = indmin(2),indmax(2)
-            do i = indmin(1),indmax(1)
-                tempP(i,j,k) = tabtemp(i,j,kuinf)
-            enddo
-            enddo
-        enddo
-    else
-        tempP = 0.
-        do j = indmin(2),indmax(2)
-        do i = indmin(1),indmax(1)
-            call Agrif_UpdateBase(type_update(3),tempP(i,j,:),tabtemp(i,j,:),   &
-                                  indmin(3),indmax(3),                  &
-                                  lb_child(3),ub_child(3),        &
-                                  s_parent(3),s_child(3),               &
-                                  ds_parent(3),ds_child(3))
-!
-        enddo
-        enddo
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_3D_Recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Update_4D_Recursive
-!
-!> Updates a 4D grid variable on the parent grid.
-!! Calls #Agrif_Update_3D_Recursive and #Agrif_UpdateBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_4D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(4),          intent(in)  :: type_update            !< Type of update (copy or average)
-    integer, dimension(4),          intent(in)  :: indmin, indmax
-    integer, dimension(4),          intent(in)  :: lb_child, ub_child
-    real,    dimension(4),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(4),          intent(in)  :: ds_child, ds_parent
-    real,    dimension(          &
-        indmin(1):indmax(1),     &
-        indmin(2):indmax(2),     &
-        indmin(3):indmax(3),     &
-        indmin(4):indmax(4)),       intent(out) :: tempP
-    real, dimension(             &
-        lb_child(1):ub_child(1), &
-        lb_child(2):ub_child(2), &
-        lb_child(3):ub_child(3), &
-        lb_child(4):ub_child(4)),   intent(in)  :: tempC
-!---------------------------------------------------------------------------------------------------
-    real, dimension(:,:,:,:), allocatable       :: tabtemp
-    integer :: i,j,k,l
-!
-    allocate(tabtemp(indmin(1):indmax(1), &
-                     indmin(2):indmax(2), &
-                     indmin(3):indmax(3), &
-                     lb_child(4):ub_child(4)))
-!
-    do l = lb_child(4), ub_child(4)
-        call Agrif_Update_3D_Recursive(type_update(1:3),                    &
-                                       tabtemp(indmin(1):indmax(1),         &
-                                               indmin(2):indmax(2),         &
-                                               indmin(3):indmax(3), l),     &
-                                       tempC(lb_child(1):ub_child(1),       &
-                                             lb_child(2):ub_child(2),       &
-                                             lb_child(3):ub_child(3), l),   &
-                                       indmin(1:3), indmax(1:3),            &
-                                       lb_child(1:3), ub_child(1:3),        &
-                                        s_child(1:3),  s_parent(1:3),       &
-                                       ds_child(1:3), ds_parent(1:3))
-    enddo
-!
-    tempP = 0.
-!
-    do k = indmin(3), indmax(3)
-    do j = indmin(2), indmax(2)
-    do i = indmin(1), indmax(1)
-        call Agrif_UpdateBase(type_update(4),                               &
-                              tempP(i,j,k,indmin(4):indmax(4)),             &
-                              tabtemp(i,j,k,lb_child(4):ub_child(4)),       &
-                              indmin(4), indmax(4),                         &
-                              lb_child(4), ub_child(4),                     &
-                               s_parent(4), s_child(4),                     &
-                              ds_parent(4),ds_child(4) )
-    enddo
-    enddo
-    enddo
-!
-    deallocate(tabtemp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_4D_Recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Update_5D_Recursive
-!
-!> Updates a 5D grid variable on the parent grid.
-!! Calls #Agrif_Update_4D_Recursive and #Agrif_UpdateBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_5D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(5),          intent(in)  :: type_update            !< Type of update (copy or average)
-    integer, dimension(5),          intent(in)  :: indmin, indmax
-    integer, dimension(5),          intent(in)  :: lb_child, ub_child
-    real,    dimension(5),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(5),          intent(in)  :: ds_child, ds_parent
-    real,    dimension(          &
-        indmin(1):indmax(1),     &
-        indmin(2):indmax(2),     &
-        indmin(3):indmax(3),     &
-        indmin(4):indmax(4),     &
-        indmin(5):indmax(5)),       intent(out) :: tempP
-    real, dimension(             &
-        lb_child(1):ub_child(1), &
-        lb_child(2):ub_child(2), &
-        lb_child(3):ub_child(3), &
-        lb_child(4):ub_child(4), &
-        lb_child(5):ub_child(5)),   intent(in)  :: tempC
-!---------------------------------------------------------------------------------------------------
-    real, dimension(:,:,:,:,:), allocatable     :: tabtemp
-    integer :: i,j,k,l,m
-!
-    allocate(tabtemp(indmin(1):indmax(1), &
-                     indmin(2):indmax(2), &
-                     indmin(3):indmax(3), &
-                     indmin(4):indmax(4), &
-                     lb_child(5):ub_child(5)))
-!
-    do m = lb_child(5), ub_child(5)
-        call Agrif_Update_4D_Recursive(type_update(1:4),                    &
-                                       tabtemp(indmin(1):indmax(1),         &
-                                               indmin(2):indmax(2),         &
-                                               indmin(3):indmax(3),         &
-                                               indmin(4):indmax(4), m),     &
-                                       tempC(lb_child(1):ub_child(1),       &
-                                             lb_child(2):ub_child(2),       &
-                                             lb_child(3):ub_child(3),       &
-                                             lb_child(4):ub_child(4), m),   &
-                                       indmin(1:4),indmax(1:4),             &
-                                       lb_child(1:4), ub_child(1:4),        &
-                                        s_child(1:4), s_parent(1:4),        &
-                                       ds_child(1:4), ds_parent(1:4))
-    enddo
-!
-    tempP = 0.
-!
-    do l = indmin(4), indmax(4)
-    do k = indmin(3), indmax(3)
-    do j = indmin(2), indmax(2)
-    do i = indmin(1), indmax(1)
-        call Agrif_UpdateBase( type_update(5),                              &
-                               tempP(i,j,k,l,indmin(5):indmax(5)),          &
-                               tabtemp(i,j,k,l,lb_child(5):ub_child(5)),    &
-                               indmin(5), indmax(5),                        &
-                               lb_child(5), ub_child(5),                    &
-                                s_parent(5), s_child(5),                    &
-                               ds_parent(5),ds_child(5) )
-    enddo
-    enddo
-    enddo
-    enddo
-!
-    deallocate(tabtemp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_5D_Recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Update_6D_Recursive
-!
-!> Updates a 6D grid variable on the parent grid.
-!! Calls #Agrif_Update_5D_Recursive and #Agrif_UpdateBase.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_6D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
-                                       ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(6),          intent(in)  :: type_update            !< Type of update (copy or average)
-    integer, dimension(6),          intent(in)  :: indmin, indmax
-    integer, dimension(6),          intent(in)  :: lb_child, ub_child
-    real,    dimension(6),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(6),          intent(in)  :: ds_child, ds_parent
-    real,    dimension(          &
-        indmin(1):indmax(1),     &
-        indmin(2):indmax(2),     &
-        indmin(3):indmax(3),     &
-        indmin(4):indmax(4),     &
-        indmin(5):indmax(5),     &
-        indmin(6):indmax(6)),       intent(out) :: tempP
-    real, dimension(             &
-        lb_child(1):ub_child(1), &
-        lb_child(2):ub_child(2), &
-        lb_child(3):ub_child(3), &
-        lb_child(4):ub_child(4), &
-        lb_child(5):ub_child(5), &
-        lb_child(6):ub_child(6)),   intent(in)  :: tempC
-!---------------------------------------------------------------------------------------------------
-    real, dimension(:,:,:,:,:,:), allocatable   :: tabtemp
-    integer :: i,j,k,l,m,n
-!
-    allocate(tabtemp(indmin(1):indmax(1), &
-                     indmin(2):indmax(2), &
-                     indmin(3):indmax(3), &
-                     indmin(4):indmax(4), &
-                     indmin(5):indmax(5), &
-                     lb_child(6):ub_child(6)))
-!
-    do n = lb_child(6),ub_child(6)
-        call Agrif_Update_5D_Recursive(type_update(1:5),                    &
-                                       tabtemp(indmin(1):indmax(1),         &
-                                               indmin(2):indmax(2),         &
-                                               indmin(3):indmax(3),         &
-                                               indmin(4):indmax(4),         &
-                                               indmin(5):indmax(5), n),     &
-                                       tempC(lb_child(1):ub_child(1),       &
-                                             lb_child(2):ub_child(2),       &
-                                             lb_child(3):ub_child(3),       &
-                                             lb_child(4):ub_child(4),       &
-                                             lb_child(5):ub_child(5), n),   &
-                                       indmin(1:5), indmax(1:5),            &
-                                       lb_child(1:5),ub_child(1:5),         &
-                                       s_child(1:5), s_parent(1:5),         &
-                                      ds_child(1:5),ds_parent(1:5))
-    enddo
-!
-    tempP = 0.
-!
-    do m = indmin(5), indmax(5)
-    do l = indmin(4), indmax(4)
-    do k = indmin(3), indmax(3)
-    do j = indmin(2), indmax(2)
-    do i = indmin(1), indmax(1)
-        call Agrif_UpdateBase( type_update(6),                              &
-                               tempP(i,j,k,l,m,indmin(6):indmax(6)),        &
-                               tabtemp(i,j,k,l,m,lb_child(6):ub_child(6)),  &
-                               indmin(6), indmax(6),                        &
-                               lb_child(6),  ub_child(6),                   &
-                                s_parent(6),  s_child(6),                   &
-                               ds_parent(6), ds_child(6) )
-    enddo
-    enddo
-    enddo
-    enddo
-    enddo
-!
-    deallocate(tabtemp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_6D_Recursive
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_UpdateBase
-!
-!> Calls the updating method chosen by the user (copy, average or full-weighting).
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_UpdateBase ( type_update,              &
-                              parent_tab, child_tab,    &
-                              indmin, indmax,           &
-                              lb_child, ub_child,       &
-                              s_parent, s_child,        &
-                              ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    integer,                            intent(in) :: type_update
-    integer,                            intent(in) :: indmin, indmax
-    integer,                            intent(in) :: lb_child, ub_child
-    real, dimension(indmin:indmax),     intent(out):: parent_tab
-    real, dimension(lb_child:ub_child), intent(in) :: child_tab
-    real,                               intent(in) :: s_parent,  s_child
-    real,                               intent(in) :: ds_parent, ds_child
-!---------------------------------------------------------------------------------------------------
-    integer :: np       ! Length of parent array
-    integer :: nc       ! Length of child  array
-!
-    np = indmax - indmin + 1
-    nc = ub_child - lb_child + 1
-!
-    if     ( type_update == Agrif_Update_Copy ) then
-!
-        call Agrif_basicupdate_copy1d(              &
-                    parent_tab, child_tab,          &
-                    np,         nc,                 &
-                    s_parent,  s_child,             &
-                    ds_parent, ds_child )
-!
-    elseif ( type_update == Agrif_Update_Average ) then
-!
-        call Agrif_basicupdate_average1d(           &
-                    parent_tab, child_tab,          &
-                    np,         nc,                 &
-                     s_parent,  s_child,            &
-                    ds_parent, ds_child )
-!
-    elseif ( type_update == Agrif_Update_Full_Weighting ) then
-!
-        call Agrif_basicupdate_full_weighting1D(    &
-                    parent_tab, child_tab,          &
-                    np,         nc,                 &
-                    s_parent,  s_child,             &
-                    ds_parent, ds_child )
-!
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_UpdateBase
-!===================================================================================================
-!
-#if defined AGRIF_MPI
-!===================================================================================================
-!  subroutine Agrif_Find_list_update
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Find_list_update ( list_update, pttab, petab, lb_child, lb_parent, nbdim, &
-                                    find_list_update, tab4t, tab5t, memberinall, memberinall2,   &
-                                    sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_List_Interp_Loc),                   pointer     :: list_update
-    INTEGER,                                       intent(in)  :: nbdim
-    INTEGER, DIMENSION(nbdim),                     intent(in)  :: pttab, petab
-    INTEGER, DIMENSION(nbdim),                     intent(in)  :: lb_child, lb_parent
-    LOGICAL,                                       intent(out) :: find_list_update
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab5t
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: memberinall,memberinall2
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc1,recvfromproc1
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc2,recvfromproc2
-!
-    Type(Agrif_List_Interp_Loc), Pointer :: parcours
-    INTEGER :: i
-!
-    find_list_update = .FALSE.
-!
-    parcours => list_update
-
-    Find_loop :  do while ( associated(parcours) )
-        do i = 1,nbdim
-            IF ((pttab(i) /= parcours%interp_loc%pttab(i)) .OR. &
-                (petab(i) /= parcours%interp_loc%petab(i)) .OR. &
-                (lb_child(i)  /= parcours%interp_loc%pttab_child(i)) .OR. &
-                (lb_parent(i) /= parcours%interp_loc%pttab_parent(i))) THEN
-                parcours => parcours%suiv
-                cycle Find_loop
-            ENDIF
-        enddo
-!
-        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
-        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
-        memberinall  =  parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
-        memberinall2 =  parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
-        sendtoproc1 =   parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
-        sendtoproc2 =   parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)
-        recvfromproc1 = parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
-        recvfromproc2 = parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)
-!
-        find_list_update = .TRUE.
-        exit Find_loop
-!
-    enddo Find_loop
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Find_list_update
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_AddTo_list_update
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_AddTo_list_update ( list_update, pttab, petab, lb_child, lb_parent,  &
-                                     nbdim, tab4t, tab5t, memberinall, memberinall2,        &
-                                     sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_List_Interp_Loc), pointer :: list_update
-    INTEGER,                                        intent(in) :: nbdim
-    INTEGER, DIMENSION(nbdim),                      intent(in) :: pttab, petab
-    INTEGER, DIMENSION(nbdim),                      intent(in) :: lb_child, lb_parent
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8),  intent(in) :: tab4t
-    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8),  intent(in) :: tab5t
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: memberinall, memberinall2
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: sendtoproc1, recvfromproc1
-    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: sendtoproc2, recvfromproc2
-!
-    Type(Agrif_List_Interp_Loc), pointer :: parcours
-!
-    allocate(parcours)
-    allocate(parcours%interp_loc)
-
-    parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
-    parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
-    parcours%interp_loc%pttab_child(1:nbdim)  = lb_child(1:nbdim)
-    parcours%interp_loc%pttab_parent(1:nbdim) = lb_parent(1:nbdim)
-
-    allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
-    allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
-
-    allocate(parcours%interp_loc%memberinall (0:Agrif_Nbprocs-1))
-    allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
-
-    allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))
-    allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))
-    allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
-    allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
-
-    parcours%interp_loc%tab4t = tab4t
-    parcours%interp_loc%tab5t = tab5t
-    parcours%interp_loc%memberinall   = memberinall
-    parcours%interp_loc%memberinall2  = memberinall2
-    parcours%interp_loc%sendtoproc1   = sendtoproc1
-    parcours%interp_loc%sendtoproc2   = sendtoproc2
-    parcours%interp_loc%recvfromproc1 = recvfromproc1
-    parcours%interp_loc%recvfromproc2 = recvfromproc2
-
-    parcours%suiv => list_update
-    list_update => parcours
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Addto_list_update
-!===================================================================================================
-#endif
-!
-end module Agrif_Update
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 10251)
@@ -0,0 +1,659 @@
+!
+! $Id: modupdatebasic.F 2715 2011-03-30 15:58:35Z rblod $
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Updatebasic
+C      
+C
+      Module Agrif_Updatebasic
+C
+CCC   Description:
+CCC   Module containing different procedures of update (copy,average,
+CCC   full_weighting) used in the Agrif_Update module.
+C
+C     Modules used:
+C
+      USE Agrif_types
+      
+      IMPLICIT NONE
+      
+      integer,dimension(:,:),allocatable :: indchildcopy
+      integer,dimension(:,:),allocatable :: indchildaverage
+C             
+
+      CONTAINS
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1d  
+C     ************************************************************************** 
+C
+      Subroutine agrif_copy1d(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
+CCC   (vector y).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+C        
+!CDIR ALTCODE
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+      
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         x(i) = y(locind_child_left)
+C
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo    
+       
+C
+      Return 
+C
+C
+      End Subroutine agrif_copy1d
+
+C     **************************************************************************  
+CCC   Subroutine Copy1dprecompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1dprecompute2d(nc2,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
+CCC   its child grid (vector y).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: nc2,np,nc
+      INTEGER             :: dir   
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildcopy_tmp
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+      if (.not.allocated(indchildcopy)) then
+      allocate(indchildcopy(np*nc2,3))
+      else
+      if (size(indchildcopy,1)<np*nc2) then
+      allocate( indchildcopy_tmp(
+     &         size(indchildcopy,1),size(indchildcopy,2)))
+      indchildcopy_tmp = indchildcopy
+      deallocate(indchildcopy)
+      allocate(indchildcopy(np*nc2,3))
+      indchildcopy(1:size(indchildcopy_tmp,1),
+     &              1:size(indchildcopy_tmp,2)) = indchildcopy_tmp
+      deallocate(indchildcopy_tmp)
+      endif
+      endif
+
+
+      do i = 1,np
+C      
+         indchildcopy(i,dir) = locind_child_left
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo
+
+      do i =2, nc2
+        indchildcopy(1+(i-1)*np:i*np,dir)=
+     &       indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc 
+      enddo
+
+C
+      Return
+C
+C
+      End Subroutine copy1dprecompute2d
+
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1dprecompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1dprecompute(np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
+CCC   its child grid (vector y).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: np,nc
+      INTEGER             :: dir
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+      if (.not.allocated(indchildcopy)) then
+      allocate(indchildcopy(np,1))
+      else
+      if (size(indchildcopy)<np) then
+      deallocate(indchildcopy)
+      allocate(indchildcopy(np,1))
+      endif
+      endif
+
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         indchildcopy(i,1) = locind_child_left
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo
+
+C
+      Return
+C
+C
+      End Subroutine copy1dprecompute
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1daftercompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1daftercompute(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
+CCC   (vector y) using precomputed index.  
+C
+CC    Method:
+C
+C     Declarations:
+C
+  
+C        
+C     Arguments
+      INTEGER             :: np,nc
+      INTEGER             :: dir
+      REAL, DIMENSION(np) :: x
+      REAL, DIMENSION(nc) :: y
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i
+C 
+C
+      
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         x(i) = y(indchildcopy(i,dir))
+C
+      enddo
+  
+C
+      Return
+C
+C
+      End Subroutine copy1daftercompute
+
+
+C
+C     **************************************************************************  
+CCC   Subroutine Average1d  
+C     ************************************************************************** 
+C   
+      Subroutine average1d(x,y,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      REAL    :: xpos, invcoeffraf 
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+      invcoeffraf = 1./coeffraf
+C
+      if (coeffraf == 1) then
+C
+          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+C        
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      xpos = s_parent      
+      
+      x = 0.
+C
+      diffmod = 0
+      
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+C
+      IF (Agrif_UseSpecialValueInUpdate) THEN
+
+      do i = 1,np
+          nbnonnuls = 0
+!CDIR NOVECTOR
+          Do ii = -coeffraf/2+locind_child_left+diffmod,
+     &                coeffraf/2+locind_child_left
+C 
+               IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
+               nbnonnuls = nbnonnuls + 1
+               x(i) = x(i) + y(ii)
+               ENDIF
+          End Do
+               IF (nbnonnuls .NE. 0) THEN
+                  x(i) = x(i)/nbnonnuls
+               ELSE
+                  x(i) = Agrif_SpecialValueFineGrid
+               ENDIF
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      ELSE 
+
+!CDIR ALTCODE
+      do i = 1,np
+!CDIR NOVECTOR
+          Do ii = -coeffraf/2+locind_child_left+diffmod,
+     &                coeffraf/2+locind_child_left
+C 
+               x(i) = x(i) + y(ii)
+          End Do
+                 x(i) = x(i)*invcoeffraf
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      ENDIF
+
+      Return 
+C            
+C     
+      End Subroutine average1d
+      
+      Subroutine average1dprecompute2d(nc2,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: nc2,np,nc,dir
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildaverage_tmp
+      REAL    :: xpos, invcoeffraf
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      xpos = s_parent
+C
+      diffmod = 0
+
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+      locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+
+      if (.not.allocated(indchildaverage)) then
+      allocate(indchildaverage(np*nc2,3))
+      else
+      if (size(indchildaverage,1)<np*nc2) then
+      allocate( indchildaverage_tmp(
+     &         size(indchildaverage,1),size(indchildaverage,2)))
+      indchildaverage_tmp = indchildaverage
+      deallocate(indchildaverage)
+      allocate(indchildaverage(np*nc2,3))
+      indchildaverage(1:size(indchildaverage_tmp,1),
+     &              1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
+      deallocate(indchildaverage_tmp)
+      endif
+      endif
+
+      do i = 1,np
+        indchildaverage(i,dir)= -coeffraf/2+locind_child_left
+     &                                    +diffmod
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+      do i = 2,nc2
+        indchildaverage(1+(i-1)*np:i*np,dir)= 
+     &                 indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc 
+      enddo
+
+      Return 
+C            
+C     
+      End Subroutine average1dprecompute2d
+      
+
+      Subroutine average1dprecompute(np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc 
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      REAL    :: xpos, invcoeffraf 
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+
+C
+      if (coeffraf == 1) then
+C
+          return
+C
+      endif
+            
+C
+      xpos = s_parent
+C
+      diffmod = 0
+      
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+
+      if (.not.allocated(indchildaverage)) then
+      allocate(indchildaverage(np,1))
+      else
+      if (size(indchildaverage,1)<np) then
+      deallocate(indchildaverage)
+      allocate(indchildaverage(np,1))
+      endif
+      endif
+      
+!CDIR ALTCODE
+      do i = 1,np
+C 
+        indchildaverage(i,1)=-coeffraf/2+locind_child_left+diffmod
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      Return 
+C            
+C     
+      End Subroutine average1dprecompute
+      
+      Subroutine average1daftercompute(x,y,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc,dir      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii,j
+      REAL    :: xpos, invcoeffraf 
+      REAL, PARAMETER :: one_third=1./3.
+      INTEGER, DIMENSION(np) :: nbnonnuls
+      INTEGER :: diffmod
+      REAL, DIMENSION(0:5) :: invcoeff=(/1.,1.,0.5,one_third,0.25,0.2/)
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+      invcoeffraf = 1./coeffraf      
+C      
+C
+      IF (Agrif_UseSpecialValueInUpdate) THEN
+
+      nbnonnuls = 0
+      do  j =1, coeffraf
+          do i=1, np
+               IF (y(indchildaverage(i,dir) + j -1) .NE. 
+     &               Agrif_SpecialValueFineGrid) THEN
+               nbnonnuls(i) = nbnonnuls(i) + 1
+               x(i) = x(i) +  y(indchildaverage(i,dir) + j -1 )
+               ENDIF
+          End Do
+      enddo
+      do i=1,np
+      x(i)= x(i)*invcoeff(nbnonnuls(i)) 
+      enddo
+
+      ELSE
+!CDIR NOLOOPCHG
+      do  j =1, coeffraf
+!CDIR VECTOR
+          do i=1, np
+             x(i) = x(i) + y(indchildaverage(i,dir) + j -1 )
+          enddo
+      enddo
+       x = x * invcoeffraf
+      ENDIF
+
+      Return 
+C            
+C     
+      End Subroutine average1daftercompute            
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Full_weighting1d  
+C     **************************************************************************  
+C
+      Subroutine full_weighting1D(x,y,np,nc,
+     &                            s_parent,s_child,ds_parent,ds_child,
+     &                            coeffraf,locind_child_left) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by full_weighting on a parent grid (vector x) 
+CCC   from its child grid (vector y).
+C 
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+      REAL    :: xpos,sumweight,weight
+      INTEGER :: ii,diffmod
+      REAL :: xposfin
+      INTEGER :: it1,it2
+      INTEGER :: i1,i2
+      REAL :: invsumweight
+      REAL :: weights(-(coeffraf):coeffraf)
+      
+C
+C
+      if (coeffraf == 1) then
+C        
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      xpos = s_parent      
+      
+       x = 0.
+
+       xposfin = s_child + ds_child * (locind_child_left - 1)
+       IF (abs(xposfin - xpos).LT.0.001) THEN
+          diffmod = 0
+       ELSE
+          diffmod = 1
+       ENDIF
+C
+             
+      if (diffmod == 1) THEN
+        invsumweight=1./(2.*coeffraf**2)
+        do i=-coeffraf,-1
+          weights(i) = invsumweight*(2*(coeffraf+i)+1)
+        enddo
+        do i=0,coeffraf-1
+          weights(i)=weights(-(i+1))
+        enddo
+        it1 = -coeffraf
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 1
+      else
+      invsumweight=1./coeffraf**2
+      do i=-(coeffraf-1),0
+        weights(i) = invsumweight*(coeffraf + i)
+      enddo
+      do i=1,coeffraf-1
+        weights(i) = invsumweight*(coeffraf - i)
+      enddo
+        it1 = -(coeffraf-1)
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 2
+      endif
+
+      sumweight = 0                    
+      do i = 1,np
+C
+          it2 = it1
+          Do ii = i1,i1+i2
+C
+           IF (Agrif_UseSpecialValueInUpdate) THEN
+            IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
+               x(i) = x(i) + weights(it2)*y(ii)
+               sumweight = sumweight+weights(it2)
+            ENDIF
+           ELSE           
+               x(i) = x(i) + weights(it2)*y(ii)
+           ENDIF           
+           
+          it2 = it2+1
+          End Do
+
+           IF (Agrif_UseSpecialValueInUpdate) THEN          
+                 IF (sumweight .NE. 0.) THEN
+                    x(i) = x(i)/sumweight
+                    sumweight = 0
+                 ELSE
+                    x(i) = Agrif_SpecialValueFineGrid
+                 ENDIF
+           ENDIF
+        
+        i1 = i1 + coeffraf
+C
+      enddo    
+C
+
+      Return 
+C            
+C
+      End Subroutine full_weighting1D 
+
+C
+      End module AGRIF_updatebasic
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 10250)
+++ 	(revision )
@@ -1,434 +1,0 @@
-!
-! $Id$
-!
-!     AGRIF (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
-!
-!
-!
-!> Module containing different procedures of update (copy, average, full_weighting)
-!! used in the #Agrif_Update module.
-!===================================================================================================
-!
-module Agrif_UpdateBasic
-!
-    use Agrif_Types
-
-    implicit none
-
-    integer, dimension(:,:), allocatable :: indchildcopy
-    integer, dimension(:,:), allocatable :: indchildaverage
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_basicupdate_copy1d
-!
-!> Carries out a copy on a parent grid (vector x) from its child grid (vector y).
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_basicupdate_copy1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    real, dimension(np), intent(out)    :: x            !< Coarse output data to parent
-    real, dimension(nc), intent(in)     :: y            !< Fine input data from child
-    integer,             intent(in)     :: np           !< Length of parent array
-    integer,             intent(in)     :: nc           !< Length of child  array
-    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
-    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
-    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
-    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
-!---------------------------------------------------------------------------------------------------
-    integer :: i, locind_child_left, coeffraf
-!
-    coeffraf = nint(ds_parent/ds_child)
-    locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-!
-    if ( coeffraf == 1 ) then
-!CDIR ALTCODE
-        x(1:np) = y(locind_child_left:locind_child_left+np-1)
-        return
-    endif
-!
-!CDIR ALTCODE
-    do i = 1,np
-        x(i) = y(locind_child_left)
-        locind_child_left = locind_child_left + coeffraf
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_basicupdate_copy1d
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_basicupdate_copy1d_before
-!
-!> Precomputes index for a copy on a parent grid (vector x) from its child grid (vector y).
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_basicupdate_copy1d_before ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
-!---------------------------------------------------------------------------------------------------
-    integer,             intent(in)     :: nc2          !< Length of parent array
-    integer,             intent(in)     :: np           !< Length of parent array
-    integer,             intent(in)     :: nc           !< Length of child  array
-    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
-    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
-    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
-    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
-    integer,             intent(in)     :: dir          !< Direction
-!---------------------------------------------------------------------------------------------------
-    integer, dimension(:,:), allocatable    :: indchildcopy_tmp
-    integer :: i, n_old, locind_child_left, coeffraf
-!
-    coeffraf = nint(ds_parent/ds_child)
-!
-    locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-
-    if ( .not.allocated(indchildcopy) ) then
-        allocate(indchildcopy(np*nc2, 3))
-    else
-        n_old = size(indchildcopy,1)
-        if ( n_old < np*nc2 ) then
-            allocate( indchildcopy_tmp(1:n_old, 3))
-            indchildcopy_tmp = indchildcopy
-            deallocate(indchildcopy)
-            allocate(indchildcopy(np*nc2, 3))
-            indchildcopy(1:n_old,:) = indchildcopy_tmp
-            deallocate(indchildcopy_tmp)
-        endif
-    endif
-!
-    do i = 1,np
-        indchildcopy(i,dir) = locind_child_left
-        locind_child_left = locind_child_left + coeffraf
-    enddo
-!
-    do i = 2,nc2
-        indchildcopy(1+(i-1)*np:i*np,dir) = indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_basicupdate_copy1d_before
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_basicupdate_copy1d_after
-!
-!> Carries out a copy on a parent grid (vector x) from its child grid (vector y)
-!! using precomputed index.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_basicupdate_copy1d_after ( x, y, np, nc, dir )
-!---------------------------------------------------------------------------------------------------
-    real, dimension(np), intent(out)    :: x            !< Coarse output data to parent
-    real, dimension(nc), intent(in)     :: y            !< Fine input data from child
-    integer,             intent(in)     :: np           !< Length of parent array
-    integer,             intent(in)     :: nc           !< Length of child  array
-    integer,             intent(in)     :: dir          !< Direction
-!---------------------------------------------------------------------------------------------------
-    integer :: i
-!
-!CDIR ALTCODE
-    do i = 1,np
-        x(i) = y(indchildcopy(i,dir))
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_basicupdate_copy1d_after
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_basicupdate_average1d
-!
-!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y).
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_basicupdate_average1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    REAL, DIMENSION(np), intent(out)    :: x
-    REAL, DIMENSION(nc), intent(in)     :: y
-    INTEGER,             intent(in)     :: np,nc
-    REAL,                intent(in)     :: s_parent,  s_child
-    REAL,                intent(in)     :: ds_parent, ds_child
-!
-    INTEGER :: i, ii, locind_child_left, coeffraf
-    REAL    :: xpos, invcoeffraf
-    INTEGER :: nbnonnuls
-    INTEGER :: diffmod
-!
-    coeffraf = nint(ds_parent/ds_child)
-    invcoeffraf = 1./coeffraf
-!
-    if (coeffraf == 1) then
-        locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-        x(1:np) = y(locind_child_left:locind_child_left+np-1)
-        return
-    endif
-!
-    xpos = s_parent
-    x = 0.
-!
-    diffmod = 0
-!
-    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
-!
-    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
-!
-    IF (Agrif_UseSpecialValueInUpdate) THEN
-        do i = 1,np
-            nbnonnuls = 0
-!CDIR NOVECTOR
-            do ii = -coeffraf/2+locind_child_left+diffmod, &
-                     coeffraf/2+locind_child_left
-                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
-!                    nbnonnuls = nbnonnuls + 1
-                    x(i) = x(i) + y(ii)
-                ENDIF
-            enddo
-!            IF (nbnonnuls /= 0) THEN
-!                x(i) = x(i)/nbnonnuls
-!            ELSE
-!                x(i) = Agrif_SpecialValueFineGrid
-!            ENDIF
-            locind_child_left = locind_child_left + coeffraf
-        enddo
-    ELSE
-!
-!CDIR ALTCODE
-        do i = 1,np
-!CDIR NOVECTOR
-            do ii = -coeffraf/2+locind_child_left+diffmod, &
-                     coeffraf/2+locind_child_left
-                x(i) = x(i) + y(ii)
-            enddo
-!            x(i) = x(i)*invcoeffraf
-            locind_child_left = locind_child_left + coeffraf
-        enddo
-        IF (.not.Agrif_Update_Weights) THEN
-           x = x * invcoeffraf
-        ENDIF
-    ENDIF
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_basicupdate_average1d
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Average1dPrecompute
-!
-!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y).
-!---------------------------------------------------------------------------------------------------
-subroutine Average1dPrecompute ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
-!---------------------------------------------------------------------------------------------------
-    INTEGER, intent(in) :: nc2, np, nc
-    REAL,    intent(in) :: s_parent,  s_child
-    REAL,    intent(in) :: ds_parent, ds_child
-    INTEGER, intent(in) :: dir
-!
-    INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp
-    INTEGER :: i, locind_child_left, coeffraf
-    REAL    :: xpos
-    INTEGER :: diffmod
-!
-    coeffraf = nint(ds_parent/ds_child)
-    xpos = s_parent
-    diffmod = 0
-!
-    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
-!
-    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
-!
-    if (.not.allocated(indchildaverage)) then
-        allocate(indchildaverage(np*nc2,3))
-    else
-        if (size(indchildaverage,1)<np*nc2) then
-            allocate( indchildaverage_tmp(size(indchildaverage,1),size(indchildaverage,2)))
-            indchildaverage_tmp = indchildaverage
-            deallocate(indchildaverage)
-            allocate(indchildaverage(np*nc2,3))
-            indchildaverage(1:size(indchildaverage_tmp,1),1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
-            deallocate(indchildaverage_tmp)
-        endif
-    endif
-!
-    do i = 1,np
-        indchildaverage(i,dir)= -coeffraf/2+locind_child_left+diffmod
-        locind_child_left = locind_child_left + coeffraf
-    enddo
-!
-    do i = 2,nc2
-        indchildaverage(1+(i-1)*np:i*np,dir) = indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Average1dPrecompute
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Average1dAfterCompute
-!
-!> Carries out an update by average on a parent grid (vector x) from its child grid (vector y).
-!---------------------------------------------------------------------------------------------------
-subroutine Average1dAfterCompute ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
-!---------------------------------------------------------------------------------------------------
-    REAL, DIMENSION(np), intent(inout)  :: x
-    REAL, DIMENSION(nc), intent(in)     :: y
-    INTEGER,             intent(in)     :: np, nc
-    REAL,                intent(in)     :: s_parent,  s_child
-    REAL,                intent(in)     :: ds_parent, ds_child
-    INTEGER,             intent(in)     :: dir
-!
-    REAL    :: invcoeffraf
-    INTEGER :: i, j, coeffraf
-    INTEGER, DIMENSION(np) :: nbnonnuls
-    REAL, DIMENSION(0:7), parameter :: invcoeff = (/1.,1.,0.5,1./3.,0.25,0.2,1./6.,1./7./)
-!
-    coeffraf = nint(ds_parent/ds_child)
-    invcoeffraf = 1./coeffraf
-!
-    IF (Agrif_UseSpecialValueInUpdate) THEN
-!
-!        nbnonnuls = 0
-        do  j = 1,coeffraf
-            do i = 1,np
-                IF (y(indchildaverage(i,dir) + j -1) /= Agrif_SpecialValueFineGrid) THEN
-!                    nbnonnuls(i) = nbnonnuls(i) + 1
-                    x(i) = x(i) +  y(indchildaverage(i,dir) + j-1 )
-                ENDIF
-            enddo
-        enddo
-        do i=1,np
-  !          x(i) = x(i)*invcoeff(nbnonnuls(i))
-  !          if (nbnonnuls(i) == 0) x(i) = Agrif_SpecialValueFineGrid
-        enddo
-!
-    ELSE
-!
-!CDIR NOLOOPCHG
-        do  j = 1,coeffraf
-!CDIR VECTOR
-            do i= 1,np
-                x(i) = x(i) + y(indchildaverage(i,dir) + j-1 )
-            enddo
-        enddo
-        IF (.not.Agrif_Update_Weights) THEN
-           x = x * invcoeffraf
-        ENDIF
-!
-    ENDIF
-
-!---------------------------------------------------------------------------------------------------
-end subroutine Average1dAfterCompute
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_basicupdate_full_weighting1D
-!
-!> Carries out an update by full_weighting on a parent grid (vector x) from its child grid (vector y).
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_basicupdate_full_weighting1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
-!---------------------------------------------------------------------------------------------------
-    real, dimension(np), intent(out)    :: x
-    real, dimension(nc), intent(in)     :: y
-    integer,             intent(in)     :: np, nc
-    real,                intent(in)     :: s_parent,  s_child
-    real,                intent(in)     :: ds_parent, ds_child
-!---------------------------------------------------------------------------------------------------
-    REAL    :: xpos, xposfin
-    INTEGER :: i, ii, diffmod
-    INTEGER :: it1, it2
-    INTEGER :: i1,  i2
-    INTEGER :: coeffraf
-    INTEGER :: locind_child_left
-    REAL    :: sumweight, invsumweight
-    REAL    :: weights(-Agrif_MaxRaff:Agrif_MaxRaff)
-
-    coeffraf = nint(ds_parent/ds_child)
-    locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
-!
-    if (coeffraf == 1) then
-        x(1:np) = y(locind_child_left:locind_child_left+np-1)
-        return
-    endif
-!
-    xpos = s_parent
-    x = 0.
-!
-    xposfin = s_child + ds_child * (locind_child_left - 1)
-    IF (abs(xposfin - xpos) < 0.001) THEN
-        diffmod = 0
-    ELSE
-        diffmod = 1
-    ENDIF
-!
-    if (diffmod == 1) THEN
-        invsumweight=1./(2.*coeffraf**2)
-        do i = -coeffraf,-1
-            weights(i) = invsumweight*(2*(coeffraf+i)+1)
-        enddo
-        do i = 0,coeffraf-1
-            weights(i) = weights(-(i+1))
-        enddo
-        it1 = -coeffraf
-        i1 = -(coeffraf-1)+locind_child_left
-        i2 = 2*coeffraf - 1
-        
-    else
-        invsumweight=1./coeffraf**2
-        do i = -(coeffraf-1),0
-            weights(i) = invsumweight*(coeffraf + i)
-        enddo
-        do i=1,coeffraf-1
-            weights(i) = invsumweight*(coeffraf - i)
-        enddo
-        it1 = -(coeffraf-1)
-        i1 = -(coeffraf-1)+locind_child_left
-        i2 = 2*coeffraf - 2
-
-    endif
-!
-    sumweight = 0.
-    MYLOOP : do i = 1,np
-!
-        it2 = it1
-
-!    sumweight = 0.
-    
-        do ii = i1,i1+i2
-!
-            IF (Agrif_UseSpecialValueInUpdate) THEN
-                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
-                    x(i) = x(i) + weights(it2)*y(ii)
-!                    sumweight = sumweight+weights(it2)
-                ELSE
-                    x(i) = Agrif_SpecialValueFineGrid
-                    i1=i1+coeffraf
-                    CYCLE MYLOOP
-                ENDIF
-            ELSE
-                x(i) = x(i) + weights(it2)*y(ii)
-            ENDIF
-
-            it2 = it2+1
-!
-        enddo
-!
-        i1 = i1 + coeffraf
-!
-        enddo MYLOOP
-        
-        IF (Agrif_UseSpecialValueInUpdate) THEN
-          x = x * coeffraf ! x will be divided by coeffraf later in modupdate.F90
-        ENDIF
-        
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_basicupdate_full_weighting1D
-!===================================================================================================
-!
-end module Agrif_UpdateBasic
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 10251)
@@ -0,0 +1,864 @@
+!
+! $Id: modutil.F 2731 2011-04-08 12:05:35Z rblod $
+!
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Util 
+C 
+      Module Agrif_Util 
+C
+C
+CCC   Description:   
+CCC   This module contains the two procedures called in the main program : 
+CCC   Agrif_Init_Grids allowing the initialization of the root coarse grid, and
+CCC   Agrif_Step allowing the creation of the grid hierarchy and the management
+CCC   of the time integration. 
+C
+C     Modules used:
+C
+      Use Agrif_Clustering    
+      Use Agrif_bcfunction
+C      
+      IMPLICIT NONE
+C
+      Contains
+C     Definition of procedures contained in this module.
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Step
+C     **************************************************************************
+C 
+      Subroutine Agrif_Step(procname) 
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy and to manage the time integration 
+CCC   procedure. It is called in the main program.
+C
+CC    Method:
+CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
+C
+C     Declarations:
+C
+      Optional :: procname
+      External :: procname
+C
+#ifdef key_mpp_mpi
+      INCLUDE 'mpif.h'
+      Integer      :: code, ierr
+      Logical      :: mpi_was_called
+C
+C
+      Call Agrif_comm_def(MPI_COMM_AGRIF)
+
+      CALL mpi_initialized ( mpi_was_called, code )
+      IF( code /= MPI_SUCCESS ) THEN
+         WRITE(*, *) ': Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_comm_dup( mpi_comm_world, MPI_COMM_AGRIF, code)
+         IF( code /= MPI_SUCCESS ) THEN
+            WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+
+      If (Agrif_Mygrid % ngridstep == 0) Then
+          Call MPI_COMM_SIZE(MPI_COMM_AGRIF,Agrif_Nbprocs,code)
+          Call MPI_COMM_RANK(MPI_COMM_AGRIF,Agrif_ProcRank,code)
+          Call MPI_COMM_GROUP(MPI_COMM_AGRIF,Agrif_Group,code)
+      endif
+#endif
+C
+C     Creation and initialization of the grid hierarchy 
+C
+C  
+C    Set the clustering variables
+C
+      Call Agrif_clustering_def()
+C      
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+C     
+         If (Agrif_Mygrid % ngridstep == 0) then
+C
+            Call Agrif_Regrid
+C 
+            Call Agrif_Instance           
+     &          (Agrif_Mygrid)           
+         endif
+C
+      else
+C    
+         If (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
+C
+            Call Agrif_Regrid
+C  
+            Call Agrif_Instance           
+     &          (Agrif_Mygrid)  
+C            
+         endif
+C
+      endif
+C
+C     Time integration of the grid hierarchy
+C
+      If (present(procname)) Then
+         Call Agrif_Integrate (Agrif_Mygrid,procname)
+      Else
+         Call Agrif_Integrate (Agrif_Mygrid)      
+      endif
+C    
+      If (associated(Agrif_Mygrid%child_grids)) 
+     &   Call Agrif_Instance (Agrif_Mygrid)
+C
+      Return
+C             
+      End Subroutine Agrif_Step      
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Step_Child
+C     **************************************************************************
+C
+      Subroutine Agrif_Step_Child(procname)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy and to manage the time integration
+CCC   procedure. It is called in the main program.
+C
+CC    Method:
+CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
+C
+C     Declarations:
+C
+      Optional :: procname
+      External :: procname
+C
+C     Time integration of the grid hierarchy
+C
+      If (present(procname)) Then
+         Call Agrif_Integrate_Child (Agrif_Mygrid,procname)
+      Else
+         Call Agrif_Integrate_Child (Agrif_Mygrid)
+      endif
+C    
+      If (associated(Agrif_Mygrid%child_grids))
+     &   Call Agrif_Instance (Agrif_Mygrid)
+C
+      Return
+C
+      End Subroutine Agrif_Step_Child
+
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Regrid
+C     **************************************************************************
+C
+      Subroutine Agrif_Regrid
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy from fixed grids and 
+CC       adaptive mesh refinement.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Local variables      
+      Type(Agrif_Rectangle), Pointer     :: coarsegrid_fixed
+      Type(Agrif_Rectangle), Pointer     :: coarsegrid_moving  
+      INTEGER                            :: j
+      INTEGER :: nunit
+      INTEGER                            :: iii
+      Logical :: BEXIST
+C 
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 )
+     &   Call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined
+C
+      Allocate(coarsegrid_fixed)
+      Allocate(coarsegrid_moving)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
+     &    Call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
+C
+      if ( Agrif_USE_FIXED_GRIDS .EQ. 1 .OR. 
+     &     Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+C
+      If (Agrif_Mygrid % ngridstep == 0) Then
+          nunit = Agrif_Get_Unit()
+          open(nunit,file='AGRIF_FixedGrids.in',form='formatted',
+     &           status="old",ERR=99) ! Opening of the Agrif_FixedGrids.in file
+          j = 1
+C         Creation of the grid hierarchy from the Agrif_FixedGrids.in file 
+            do iii = 1 , Agrif_Probdim
+               coarsegrid_fixed % imin(iii) = 1
+               coarsegrid_fixed % imax(iii) = Agrif_Mygrid % nb(iii) + 1
+            enddo
+C      
+            Call Agrif_Read_Fix_Grd (coarsegrid_fixed,j,nunit)     
+            close(nunit) ! Closing of the Agrif_FixedGrids.in file 
+C
+          Nullify(Agrif_oldmygrid)
+          Nullify(Agrif_Mygrid  % child_grids)
+C        
+C         Creation of the grid hierarchy from coarsegrid_fixed
+            Call Agrif_Create_Grids (Agrif_Mygrid,coarsegrid_fixed)
+        Else        
+          Agrif_oldmygrid => Agrif_Mygrid % child_grids
+         endif
+      else
+      Agrif_oldmygrid => Agrif_Mygrid % child_grids
+      Nullify(Agrif_Mygrid  % child_grids)
+      endif
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C
+      Call Agrif_Save_All(Agrif_oldmygrid)      
+C      
+      Call Agrif_Free_before_All(Agrif_oldmygrid)
+C 
+C     Creation of the grid hierarchy from coarsegrid_moving    
+      Call Agrif_Create_Grids
+     &     (Agrif_Mygrid,coarsegrid_moving)
+C
+      endif
+C
+C     Initialization of the grid hierarchy by copy or interpolation
+C
+      Call Agrif_Init_Hierarchy(Agrif_Mygrid)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
+     &        Call Agrif_Free_after_All(Agrif_oldmygrid)
+C
+      Deallocate(coarsegrid_fixed)
+      Deallocate(coarsegrid_moving)
+C      
+      Return
+C
+C     Opening error
+C
+   99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+      If (.not. BEXIST) Then
+          print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+          STOP 
+        Else
+          print*,'Error opening file AGRIF_FixedGrids.in'
+          STOP         
+      endif     
+C      
+      End Subroutine Agrif_Regrid
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_detect_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_detect_all(g)
+C
+CCC   Description:
+CCC   Subroutine to detect areas to be refined.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid) ,pointer  :: g        ! Pointer on the current grid
+C      
+C     Local variables
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+      INTEGER, DIMENSION(3)      :: size
+      INTEGER                    :: iii
+      Real :: g_eps     
+C
+      parcours => g % child_grids
+C  
+C     To be positioned on the finer grids of the grid hierarchy          
+C  
+      do while (associated(parcours))       
+         Call Agrif_detect_all (parcours % gr)  
+        parcours => parcours % next             
+      enddo
+C
+      g_eps = huge(1.)
+      do iii = 1 , Agrif_Probdim
+         g_eps=min(g_eps,g%Agrif_d(iii))
+      enddo
+C
+      g_eps = g_eps/100.
+C          
+      if ( Agrif_Probdim .EQ. 1 ) g%tabpoint1D=0
+      if ( Agrif_Probdim .EQ. 2 ) g%tabpoint2D=0
+      if ( Agrif_Probdim .EQ. 3 ) g%tabpoint3D=0
+C      
+      do iii = 1 , Agrif_Probdim
+         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
+     &                     (Agrif_mind(iii)-g_eps)) Return
+      enddo
+C                                       
+      Call Agrif_instance(g)
+C  
+C     Detection (Agrif_detect is a user s routine)
+C      
+     
+      do iii = 1 , Agrif_Probdim
+         size(iii) = g%nb(iii) + 1
+      enddo
+C
+      SELECT CASE (Agrif_Probdim)
+      CASE (1) 
+         Call Agrif_detect(g%tabpoint1D,size)
+      CASE (2) 
+         Call Agrif_detect(g%tabpoint2D,size)
+      CASE (3) 
+         Call Agrif_detect(g%tabpoint3D,size)
+      END SELECT
+C
+C     Addition of the areas detected on the child grids
+C      
+      parcours => g % child_grids 
+C           
+      Do while (associated(parcours))
+        Call Agrif_Add_detected_areas (g,parcours % gr)
+        parcours => parcours % next 
+      enddo
+C     
+      Return      
+C
+      End Subroutine Agrif_detect_all
+C      
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Add_detected_areas
+C     **************************************************************************
+C      
+      Subroutine Agrif_Add_detected_areas(parentgrid,childgrid)
+C
+CCC   Description:
+CCC   Subroutine to add on the parent grid the areas detected 
+CC       on its child grids.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C 
+      Type(Agrif_Grid),pointer   :: parentgrid,childgrid
+C      
+      Integer :: i,j,k
+C
+      do i = 1,childgrid%nb(1)+1
+         if ( Agrif_Probdim .EQ. 1 ) then
+            If (childgrid%tabpoint1D(i).EQ.1) Then
+                parentgrid%tabpoint1D(childgrid%ix(1)+
+     &                 (i-1)/Agrif_Coeffref(1)) = 1
+            endif
+         else
+            do j=1,childgrid%nb(2)+1
+               if (Agrif_Probdim.EQ.2) then
+              If (childgrid%tabpoint2D(i,j).EQ.1) Then
+                  parentgrid%tabpoint2D(
+     &                  childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
+     &                  childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
+                  endif
+               else
+                  do k=1,childgrid%nb(3)+1
+                If (childgrid%tabpoint3D(i,j,k).EQ.1) Then
+                    parentgrid%tabpoint3D(
+     &                     childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
+     &                     childgrid%ix(2)+(j-1)/Agrif_Coeffref(2),
+     &                     childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
+                     endif
+                  enddo
+               endif
+            enddo
+         endif
+      enddo
+C      
+      Return
+C
+      End Subroutine Agrif_Add_detected_areas   
+C      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_before_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Free_before_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+C
+C
+      parcours => g        
+C      
+      Do while (associated(parcours))     
+        If (.not. parcours%gr%fixed) Then
+            Call Agrif_Free_data_before(parcours%gr)
+            parcours % gr % oldgrid = .TRUE.        
+        endif
+C
+        Call Agrif_Free_before_all (parcours % gr % child_grids)
+C  
+        parcours => parcours % next             
+      enddo
+C     
+      Return      
+C
+C
+      End Subroutine Agrif_Free_before_All
+C     **************************************************************************
+CCC   Subroutine Agrif_Save_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Save_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+C
+C
+      parcours => g        
+C      
+      Do while (associated(parcours))     
+        If (.not. parcours%gr%fixed) Then
+            Call Agrif_Instance(parcours%gr)
+            Call Agrif_Before_Regridding()
+            parcours % gr % oldgrid = .TRUE.        
+        endif
+C
+        Call Agrif_Save_All (parcours % gr % child_grids)
+C  
+        parcours => parcours % next             
+      enddo
+C     
+      Return      
+C
+C
+      End Subroutine Agrif_Save_All      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_after_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Free_after_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g       ! Pointer on the current grid
+C
+C     Local pointers
+      TYPE(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive proced
+      Type(Agrif_pgrid),pointer  :: preparcours   
+      Type(Agrif_pgrid),pointer  :: preparcoursini 
+C
+C
+      Allocate(preparcours)
+C 
+      preparcoursini => preparcours
+C 
+      Nullify(preparcours % gr)
+C 
+      preparcours % next => g
+C
+      parcours => g
+C      
+      Do while (associated(parcours))
+C
+         if ( (.NOT. parcours% gr% fixed) .AND.
+     &        (parcours% gr% oldgrid    ) ) then
+          Call Agrif_Free_data_after(parcours%gr)
+         endif
+C
+         Call Agrif_Free_after_all (parcours % gr % child_grids)
+C
+      If (parcours % gr % oldgrid) Then
+          Deallocate(parcours % gr)
+          preparcours % next => parcours % next
+          Deallocate(parcours)
+          parcours => preparcours % next
+        Else
+          preparcours => preparcours % next
+          parcours => parcours % next 
+         endif       
+      enddo
+C
+      Deallocate(preparcoursini)
+C     
+      Return      
+C
+      End Subroutine Agrif_Free_after_All
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Integrate
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Integrate(g, procname)         
+C
+CCC   Description:
+CCC   Subroutine to manage the time integration of the grid hierarchy.
+C
+CC    Method:
+CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
+C
+C     main procedure name
+      Optional :: procname
+      External :: procname      
+C      
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure
+C
+C     Local scalars
+      INTEGER                    :: nbt      ! Number of time steps 
+                                             ! of the current grid
+      INTEGER                    :: k        
+      INTEGER                    :: iii
+C  
+C     Instanciation of the variables of the current grid
+      If (g%fixedrank .NE.0) Then      
+      Call Agrif_Instance
+     &     (g)
+      End If
+C       
+C     One step on the current grid      
+C
+      If (present(procname)) Then
+         Call procname ()      
+      Else
+        write(*,*) 'The name of the step subroutine has not '
+        write(*,*) 'been given in the subroutine Agrif_Integrate'
+        stop
+      endif
+C
+C     Number of time steps on the current grid      
+C
+      g%ngridstep = g % ngridstep + 1
+C      
+      parcours => g % child_grids
+C    
+C     Recursive procedure for the time integration of the grid hierarchy      
+      Do while (associated(parcours))
+C
+C       Instanciation of the variables of the current grid            
+        Call Agrif_Instance
+     &           (parcours % gr)
+C       
+C       Number of time steps
+        nbt = 1
+        do iii = 1 , Agrif_Probdim
+           nbt = max(nbt, parcours % gr % timeref(iii))
+        enddo
+C       
+        Do k = 1,nbt
+C       
+           If (present(procname)) Then
+                 Call Agrif_Integrate (parcours % gr, procname)
+           Else
+                 Call Agrif_Integrate (parcours % gr)      
+           endif
+C       
+        enddo     
+C  
+        parcours => parcours % next
+C     
+      enddo
+C
+C      
+      End Subroutine Agrif_Integrate 
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Integrate_Child
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Integrate_Child(g,procname)
+C
+CCC   Description:
+CCC   Subroutine to manage the time integration of the grid hierarchy.
+C
+CC    Method:
+CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+C
+C     Declarations:
+C
+
+C
+C     Pointer argument
+      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
+C
+C     main procedure name
+      Optional :: procname
+      External :: procname
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
+                                             ! procedure
+C
+C     One step on the current grid
+C
+      If (present(procname)) Then
+         Call procname ()      
+      Else
+        write(*,*) 'The name of the step subroutine has not '
+        write(*,*) 'been given in the subroutine Agrif_Integrate'
+        stop
+      endif
+C
+C     Number of time steps on the current grid
+C
+C
+      parcours => g % child_grids
+C
+C     Recursive procedure for the time integration of the grid hierarchy      
+      Do while (associated(parcours))
+C
+C       Instanciation of the variables of the current grid
+        Call Agrif_Instance
+     &           (parcours % gr)
+
+C       
+           If (present(procname)) Then
+                 Call Agrif_Integrate_Child (parcours % gr, procname)
+           Else
+                 Call Agrif_Integrate_Child (parcours % gr)
+           endif
+C  
+        parcours => parcours % next
+C     
+      enddo
+C
+C
+      End Subroutine Agrif_Integrate_Child
+
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_Grids
+C     **************************************************************************
+C      
+      Subroutine Agrif_Init_Grids
+C
+CCC   Description:
+CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
+CCC   It is called in the main program.
+C
+C     Declarations:
+C
+C
+      INTEGER :: iii
+C
+C             definition of the probdim and modtypes variables
+C
+#ifdef key_mpp_mpi
+      INCLUDE 'mpif.h'
+      Agrif_MPIPREC = MPI_DOUBLE_PRECISION
+#endif
+      Call Agrif_probdim_modtype_def()
+C      
+      Agrif_UseSpecialValue = .FALSE.
+      Agrif_UseSpecialValueFineGrid = .FALSE.
+      Agrif_SpecialValue = 0.
+      Agrif_SpecialValueFineGrid = 0.
+C      
+C     Allocation of Agrif_Mygrid
+      allocate(Agrif_Mygrid)
+C      
+C     Space and time refinement factors are set to 1 on the root grid
+C
+      do iii = 1 , Agrif_Probdim
+         Agrif_Mygrid % spaceref(iii) = 1
+         Agrif_Mygrid % timeref(iii) = 1
+      enddo
+C      
+C     Initialization of the number of time steps    
+      Agrif_Mygrid % ngridstep = 0
+      Agrif_Mygrid % grid_id = 0
+C
+C     No parent grid for the root coarse grid
+      Nullify(Agrif_Mygrid % parent)
+C      
+C     Initialization of the minimum positions, global abscissa and space steps  
+      do iii= 1 ,  Agrif_Probdim
+         Agrif_Mygrid % ix(iii) = 1            
+         Agrif_Mygrid % Agrif_x(iii) = 0.
+         Agrif_Mygrid % Agrif_d(iii) = 1. 
+C     Borders of the root coarse grid 
+         Agrif_Mygrid % NearRootBorder(iii) = .true.  
+         Agrif_Mygrid % DistantRootBorder(iii) = .true.      
+      enddo
+C  
+C     The root coarse grid is a fixed grid
+      Agrif_Mygrid % fixed = .TRUE.
+C     Level of the root grid
+      Agrif_Mygrid % level = 0
+C     Maximum level in the hierarchy
+      Agrif_MaxLevelLoc = 0
+      
+C      
+C     Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+      Agrif_Mygrid % rank = 1      
+C 
+C     Number of the root grid as a fixed grid   
+      Agrif_Mygrid % fixedrank = 0  
+C 
+C     Initialization of some fields of the root grid variables     
+      Call Agrif_Create_Var (Agrif_Mygrid)
+C      
+C     Initialization of the other fields of the root grid variables (number of 
+C     cells, positions, number and type of its dimensions, ...)  
+      Call Agrif_Set_numberofcells(Agrif_Mygrid)
+C      
+      Call Agrif_Instance (Agrif_Mygrid)        
+C
+      Call Agrif_Set_numberofcells(Agrif_Mygrid)          
+C             
+C     Allocation of the array containing the values of the grid variables
+      Call Agrif_Allocation (Agrif_Mygrid)
+C        
+      Call Agrif_initialisations(Agrif_Mygrid)    
+C      
+      nullify(Agrif_Mygrid % child_grids)
+C 
+C     Total number of fixed grids   
+      Agrif_nbfixedgrids = 0         
+C      
+      Call Agrif_Instance (Agrif_Mygrid)
+C        
+      End Subroutine Agrif_Init_Grids  
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Deallocation
+C     **************************************************************************
+C      
+      Subroutine Agrif_Deallocation
+C
+CCC   Description:
+CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
+CCC   It is called in the main program.
+C
+C     Declarations:
+C
+C
+      INTEGER :: nb
+C
+C             definition of the probdim and modtypes variables
+C
+      do nb = 1, Agrif_NbVariables
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2)
+      enddo
+C
+      do nb = 1, Agrif_NbVariables
+        Deallocate(Agrif_Mygrid % tabvars(nb) % var)
+      enddo
+C
+      Deallocate(Agrif_Mygrid % tabvars)
+C
+      Deallocate(Agrif_Mygrid)
+C
+      End Subroutine  Agrif_Deallocation 
+C
+      End module Agrif_Util 
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 10250)
+++ 	(revision )
@@ -1,1108 +1,0 @@
-!
-! $Id$
-!
-!     Agrif (Adaptive Grid Refinement In Fortran)
-!
-!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-!                        Christophe Vouland (Christophe.Vouland@imag.fr)
-!
-!     This program is free software; you can redistribute it and/or modify
-!     it under the terms of the GNU General Public License as published by
-!     the Free Software Foundation; either version 2 of the License, or
-!     (at your option) any later version.
-!
-!     This program is distributed in the hope that it will be useful,
-!     but WITHOUT ANY WARRANTY; without even the implied warranty of
-!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-!     GNU General Public License for more details.
-!
-!     You should have received a copy of the GNU General Public License
-!     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
-!
-!> Module Agrif_Util
-!!
-!! This module contains the two procedures called in the main program :
-!! - #Agrif_Init_Grids allows the initialization of the root coarse grid
-!! - #Agrif_Step allows the creation of the grid hierarchy and the management of the time integration.
-!
-module Agrif_Util
-!
-    use Agrif_Clustering
-    use Agrif_BcFunction
-    use Agrif_seq
-!
-    implicit none
-!
-    abstract interface
-        subroutine step_proc()
-        end subroutine step_proc
-    end interface
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_Step
-!
-!> Creates the grid hierarchy and manages the time integration procedure.
-!> It is called in the main program.
-!> Calls subroutines #Agrif_Regrid and #Agrif_Integrate.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Step ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)    :: procname     !< subroutine to call on each grid
-    type(agrif_grid), pointer :: ref_grid
-!
-! Set the clustering variables
-    call Agrif_clustering_def()
-!
-! Creation and initialization of the grid hierarchy
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
-!
-        if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then
-            call Agrif_Regrid()
-            Agrif_regrid_has_been_done = .TRUE.
-        endif
-!
-    else
-!
-        if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then
-            call Agrif_Regrid()
-        endif
-!
-    endif
-!
-! Time integration of the grid hierarchy
-    if (agrif_coarse) then
-      ref_grid => agrif_coarsegrid
-    else
-      ref_grid => agrif_mygrid
-    endif
-    if ( Agrif_Parallel_sisters ) then
-        call Agrif_Integrate_Parallel(ref_grid,procname)
-    else
-        call Agrif_Integrate(ref_grid,procname)
-    endif
-!
-    if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Step
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Step_Child
-!
-!> Apply 'procname' to each grid of the hierarchy
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Step_Child ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)    :: procname     !< subroutine to call on each grid
-!
-    if ( Agrif_Parallel_sisters ) then
-        call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname)
-    else
-        call Agrif_Integrate_Child(Agrif_Mygrid,procname)
-    endif
-!
-    if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Step_Child
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Regrid
-!
-!> Creates the grid hierarchy from fixed grids and adaptive mesh refinement.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Regrid ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(init_proc), optional    :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
-!
-    type(Agrif_Rectangle), pointer     :: coarsegrid_fixed
-    type(Agrif_Rectangle), pointer     :: coarsegrid_moving
-    integer                            :: i, j
-    integer :: nunit
-    logical :: BEXIST
-    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
-    integer :: is_coarse, rhox, rhoy, rhoz, rhot
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
-        call Agrif_detect_all(Agrif_Mygrid)     ! Detection of areas to be refined
-!
-    allocate(coarsegrid_fixed)
-    allocate(coarsegrid_moving)
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
-        call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
-!
-    if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
-!
-        if (Agrif_Mygrid % ngridstep == 0) then
-!            
-            nunit = Agrif_Get_Unit()
-            open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99)
-            if (agrif_coarse) then ! SKIP the coarse grid declaration
-                if (Agrif_Probdim == 3) then
-                    read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
-                elseif (Agrif_Probdim == 2) then
-                    read(nunit,*) is_coarse, rhox, rhoy, rhot
-                elseif (Agrif_Probdim == 2) then
-                    read(nunit,*) is_coarse, rhox, rhot
-                endif
-            endif
-!           Creation of the grid hierarchy from the Agrif_FixedGrids.in file
-            do i = 1,Agrif_Probdim
-                coarsegrid_fixed % imin(i) = 1
-                coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1
-            enddo
-            j = 1
-            call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit)
-            close(nunit)
-!
-            call Agrif_gl_clear(Agrif_oldmygrid)
-!
-!           Creation of the grid hierarchy from coarsegrid_fixed
-            call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed)
-            
-        else
-            call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
-        endif
-    else
-        call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
-        call Agrif_gl_clear(Agrif_Mygrid % child_list)
-    endif
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
-!
-        call Agrif_Save_All(Agrif_oldmygrid)
-        call Agrif_Free_before_All(Agrif_oldmygrid)
-!
-!       Creation of the grid hierarchy from coarsegrid_moving
-        call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving)
-!
-    endif
-!
-!   Initialization of the grid hierarchy by copy or interpolation
-!
-#if defined AGRIF_MPI
-    if ( Agrif_Parallel_sisters ) then
-        call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid)
-        call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname)
-    else
-        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
-    endif
-#else
-        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
-#endif
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid)
-!
-    Agrif_regrid_has_been_done = .TRUE.
-!
-    call Agrif_Instance( Agrif_Mygrid )
-!
-    deallocate(coarsegrid_fixed)
-    deallocate(coarsegrid_moving)
-!
-    return
-!
-!     Opening error
-!
-99  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
-    if (.not. BEXIST) then
-        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
-        STOP
-    else
-        print*,'Error opening file AGRIF_FixedGrids.in'
-        STOP
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Regrid
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_detect_All
-!
-!> Detects areas to be refined.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_detect_all ( g )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Grid),  pointer  :: g        !< Pointer on the current grid
-!
-    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    integer, DIMENSION(3)       :: size
-    integer                     :: i
-    real                        :: g_eps
-!
-    parcours => g % child_list % first
-!
-!   To be positioned on the finer grids of the grid hierarchy
-!
-    do while (associated(parcours))
-        call Agrif_detect_all(parcours % gr)
-        parcours => parcours % next
-    enddo
-!
-    g_eps = huge(1.)
-    do i = 1,Agrif_Probdim
-        g_eps = min(g_eps, g % Agrif_dx(i))
-    enddo
-!
-    g_eps = g_eps / 100.
-!
-    if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0
-    if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0
-    if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0
-!
-    do i = 1,Agrif_Probdim
-        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return
-    enddo
-!
-    call Agrif_instance(g)
-!
-!   Detection (Agrif_detect is a users routine)
-!
-    do i = 1,Agrif_Probdim
-        size(i) = g % nb(i) + 1
-    enddo
-!
-    SELECT CASE (Agrif_Probdim)
-    CASE (1)
-        call Agrif_detect(g%tabpoint1D,size)
-    CASE (2)
-        call Agrif_detect(g%tabpoint2D,size)
-    CASE (3)
-        call Agrif_detect(g%tabpoint3D,size)
-    END SELECT
-!
-!   Addition of the areas detected on the child grids
-!
-    parcours => g % child_list % first
-!
-    do while (associated(parcours))
-        call Agrif_Add_detected_areas(g,parcours % gr)
-        parcours => parcours % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_detect_all
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Add_detected_areas
-!
-!> Adds on the parent grid the areas detected on its child grids
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Add_detected_areas ( parentgrid, childgrid )
-!---------------------------------------------------------------------------------------------------
-    Type(Agrif_Grid), pointer   :: parentgrid
-    Type(Agrif_Grid), pointer   :: childgrid
-!
-    integer :: i,j,k
-!
-    do i = 1,childgrid%nb(1)+1
-        if ( Agrif_Probdim == 1 ) then
-            if (childgrid%tabpoint1D(i)==1) then
-                parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1
-            endif
-        else
-            do j=1,childgrid%nb(2)+1
-                if (Agrif_Probdim==2) then
-                    if (childgrid%tabpoint2D(i,j)==1) then
-                        parentgrid%tabpoint2D(                       &
-                            childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
-                            childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
-                    endif
-                else
-                    do k=1,childgrid%nb(3)+1
-                        if (childgrid%tabpoint3D(i,j,k)==1) then
-                            parentgrid%tabpoint3D(                       &
-                                childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
-                                childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), &
-                                childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
-                        endif
-                    enddo
-                endif
-            enddo
-        endif
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Add_detected_areas
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Free_before_All
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Free_before_All ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    Type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
-!
-    Type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
-!
-    parcours => gridlist % first
-!
-    do while (associated(parcours))
-!
-        if (.not. parcours%gr%fixed) then
-            call Agrif_Free_data_before(parcours%gr)
-            parcours % gr % oldgrid = .TRUE.
-        endif
-!
-        call Agrif_Free_before_all (parcours % gr % child_list)
-!
-        parcours => parcours % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Free_before_All
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Save_All
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Save_All ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
-!
-    type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
-!
-    parcours => gridlist % first
-!
-    do while (associated(parcours))
-!
-        if (.not. parcours%gr%fixed) then
-            call Agrif_Instance(parcours%gr)
-            call Agrif_Before_Regridding()
-            parcours % gr % oldgrid = .TRUE.
-        endif
-!
-        call Agrif_Save_All(parcours % gr % child_list)
-!
-        parcours => parcours % next
-!
-      enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Save_All
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Free_after_All
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Free_after_All ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    Type(Agrif_Grid_List), intent(inout)    :: gridlist       !< Grid list to free
-!
-    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive proced
-    Type(Agrif_PGrid), pointer  :: preparcours
-    Type(Agrif_PGrid), pointer  :: preparcoursini
-!
-    allocate(preparcours)
-!
-    preparcoursini => preparcours
-!
-    nullify(preparcours % gr)
-!
-    preparcours % next => gridlist % first
-    parcours => gridlist % first
-!
-    do while (associated(parcours))
-!
-        if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then
-            call Agrif_Free_data_after(parcours%gr)
-        endif
-!
-        call Agrif_Free_after_all( parcours%gr % child_list )
-!
-        if (parcours % gr % oldgrid) then
-            deallocate(parcours % gr)
-            preparcours % next => parcours % next
-            deallocate(parcours)
-            parcours => preparcours % next
-        else
-            preparcours => preparcours % next
-            parcours => parcours % next
-        endif
-!
-    enddo
-!
-    deallocate(preparcoursini)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Free_after_All
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate
-!
-!> Manages the time integration of the grid hierarchy.
-!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    integer                     :: nbt      ! Number of time steps of the current grid
-    integer                     :: i, k
-!
-!   Instanciation of the variables of the current grid
-!    if ( g % fixedrank /= 0 ) then
-        call Agrif_Instance(g)
-!    endif
-!
-!   One step on the current grid
-!
-    call procname ()
-!
-!   Number of time steps on the current grid
-!
-    g%ngridstep = g % ngridstep + 1
-    parcours => g % child_list % first
-!
-!   Recursive procedure for the time integration of the grid hierarchy
-    do while (associated(parcours))
-!
-!       Instanciation of the variables of the current grid
-        call Agrif_Instance(parcours % gr)
-!
-!       Number of time steps
-        nbt = 1
-        do i = 1,Agrif_Probdim
-            nbt = max(nbt, parcours % gr % timeref(i))
-        enddo
-!
-        do k = 1,nbt
-            call Agrif_Integrate(parcours % gr, procname)
-        enddo
-!
-        parcours => parcours % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate_Parallel
-!
-!> Manages the time integration of the grid hierarchy in parallel
-!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_Parallel ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-#if defined AGRIF_MPI
-    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
-    integer                     :: nbt      ! Number of time steps of the current grid
-    integer                     :: i, k, is
-!
-!   Instanciation of the variables of the current grid
-    if ( g % fixedrank /= 0 ) then
-        call Agrif_Instance(g)
-    endif
-!
-! One step on the current grid
-    call procname ()
-!
-! Number of time steps on the current grid
-    g % ngridstep = g % ngridstep + 1
-!
-! Continue only if the grid has defined sequences of child integrations.
-    if ( .not. associated(g % child_seq) ) return
-!
-    do is = 1, g % child_seq % nb_seqs
-!
-!     For each sequence, a given processor does integrate only on grid.
-        gridp => Agrif_seq_select_child(g,is)
-!
-!     Instanciation of the variables of the current grid
-        call Agrif_Instance(gridp % gr)
-!
-!     Number of time steps
-        nbt = 1
-        do i = 1,Agrif_Probdim
-            nbt = max(nbt, gridp % gr % timeref(i))
-        enddo
-!
-        do k = 1,nbt
-            call Agrif_Integrate_Parallel(gridp % gr, procname)
-        enddo
-!
-    enddo
-#else
-    call Agrif_Integrate( g, procname )
-#endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_Parallel
-!===================================================================================================
-!
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate_ChildGrids
-!
-!> Manages the time integration of the grid hierarchy.
-!! Call the subroutine procname on each child grid of the current grid
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_ChildGrids ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    integer                     :: nbt      ! Number of time steps of the current grid
-    integer                     :: i, k, is
-    type(Agrif_Grid)                    , pointer :: save_grid
-    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
-    
-    save_grid => Agrif_Curgrid
-
-! Number of time steps on the current grid
-    save_grid % ngridstep = save_grid % ngridstep + 1
-    
-#ifdef AGRIF_MPI
-    if ( .not. Agrif_Parallel_sisters ) then
-#endif
-    parcours => save_grid % child_list % first
-!
-!   Recursive procedure for the time integration of the grid hierarchy
-    do while (associated(parcours))
-!
-!       Instanciation of the variables of the current grid
-        call Agrif_Instance(parcours % gr)
-!
-!       Number of time steps
-        nbt = 1
-        do i = 1,Agrif_Probdim
-            nbt = max(nbt, parcours % gr % timeref(i))
-        enddo
-!
-        do k = 1,nbt
-            call procname()
-        enddo
-!
-        parcours => parcours % next
-!
-    enddo
-
-#ifdef AGRIF_MPI
-    else
-#endif    
-! Continue only if the grid has defined sequences of child integrations.
-    if ( .not. associated(save_grid % child_seq) ) return
-!
-    do is = 1, save_grid % child_seq % nb_seqs
-!
-!     For each sequence, a given processor does integrate only on grid.
-        gridp => Agrif_seq_select_child(save_grid,is)
-!
-!     Instanciation of the variables of the current grid
-        call Agrif_Instance(gridp % gr)
-!
-!     Number of time steps
-        nbt = 1
-        do i = 1,Agrif_Probdim
-            nbt = max(nbt, gridp % gr % timeref(i))
-        enddo
-!
-        do k = 1,nbt
-            call procname()
-        enddo
-!
-    enddo
-#ifdef AGRIF_MPI
-    endif
-#endif 
-
-    call Agrif_Instance(save_grid)
-    
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_ChildGrids
-!===================================================================================================
-!===================================================================================================
-!  subroutine Agrif_Integrate_Child
-!
-!> Manages the time integration of the grid hierarchy.
-!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_Child ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-!
-!   One step on the current grid
-!
-    call procname ()
-!
-!   Number of time steps on the current grid
-!
-    parcours => g % child_list % first
-!
-!   Recursive procedure for the time integration of the grid hierarchy
-    do while (associated(parcours))
-!
-!       Instanciation of the variables of the current grid
-        call Agrif_Instance(parcours % gr)
-        call Agrif_Integrate_Child (parcours % gr, procname)
-        parcours => parcours % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_Child
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate_Child_Parallel
-!
-!> Manages the time integration of the grid hierarchy.
-!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-#if defined AGRIF_MPI
-    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
-    integer                     :: is
-!
-! Instanciation of the variables of the current grid
-    call Agrif_Instance(g)
-!
-! One step on the current grid
-    call procname ()
-!
-! Continue only if the grid has defined sequences of child integrations.
-    if ( .not. associated(g % child_seq) ) return
-!
-    do is = 1, g % child_seq % nb_seqs
-!
-!     For each sequence, a given processor does integrate only on grid.
-        gridp => Agrif_seq_select_child(g,is)
-        call Agrif_Integrate_Child_Parallel(gridp % gr, procname)
-!
-    enddo
-!
-    call Agrif_Instance(g)
-#else
-    call Agrif_Integrate_Child( g, procname )
-#endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_Child_Parallel
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Init_Grids
-!
-!> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Init_Grids ( procname1, procname2 )
-!---------------------------------------------------------------------------------------------------
-    procedure(typedef_proc), optional   :: procname1 !< (Default: Agrif_probdim_modtype_def)
-    procedure(alloc_proc),   optional   :: procname2 !< (Default: Agrif_Allocationcalls)
-!
-    integer :: i, ierr_allocate, nunit
-    integer :: is_coarse, rhox,rhoy,rhoz,rhot
-    logical :: BEXIST
-!
-    if (present(procname1)) Then
-        call procname1()
-    else
-        call Agrif_probdim_modtype_def()
-    endif
-!
-
-! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in
-    nunit = Agrif_Get_Unit()
-    open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98)
-    if (Agrif_Probdim == 3) then
-       read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
-    elseif (Agrif_Probdim == 2) then
-       read(nunit,*) is_coarse, rhox, rhoy, rhot
-    elseif (Agrif_Probdim == 2) then
-       read(nunit,*) is_coarse, rhox, rhot
-    endif
-    if (is_coarse == -1) then
-       agrif_coarse = .TRUE.
-       if (Agrif_Probdim == 3) then
-          coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/)
-       elseif (Agrif_Probdim == 2) then
-          coarse_spaceref(1:2)=(/rhox,rhoy/)
-       elseif (Agrif_Probdim == 2) then
-          coarse_spaceref(1:1)=(/rhox/)
-       endif
-       coarse_timeref(1:Agrif_Probdim) = rhot
-    endif
-    close(nunit)
-    
-    Agrif_UseSpecialValue = .FALSE.
-    Agrif_UseSpecialValueFineGrid = .FALSE.
-    Agrif_SpecialValue = 0.
-    Agrif_SpecialValueFineGrid = 0.
-!
-    allocate(Agrif_Mygrid)
-    allocate(Agrif_OldMygrid)
-!
-!   Space and time refinement factors are set to 1 on the root grid
-!
-    do i = 1,Agrif_Probdim
-        Agrif_Mygrid % spaceref(i) = coarse_spaceref(i)
-        Agrif_Mygrid % timeref(i)  = coarse_timeref(i)
-    enddo
-!
-!   Initialization of the number of time steps
-    Agrif_Mygrid % ngridstep = 0
-    Agrif_Mygrid % grid_id   = 0
-!
-!   No parent grid for the root coarse grid
-    nullify(Agrif_Mygrid % parent)
-!
-!   Initialization of the minimum positions, global abscissa and space steps
-    do i = 1, Agrif_Probdim
-        Agrif_Mygrid % ix(i) = 1
-        Agrif_Mygrid % Agrif_x(i)  = 0.
-        Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i)
-        Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i)
-!       Borders of the root coarse grid
-        Agrif_Mygrid % NearRootBorder(i) = .true.
-        Agrif_Mygrid % DistantRootBorder(i) = .true.
-    enddo
-!
-!   The root coarse grid is a fixed grid
-    Agrif_Mygrid % fixed = .TRUE.
-!   Level of the root grid
-    Agrif_Mygrid % level = 0
-!   Maximum level in the hierarchy
-    Agrif_MaxLevelLoc = 0
-!
-!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
-    Agrif_Mygrid % rank = 1
-!
-!   Number of the root grid as a fixed grid
-    Agrif_Mygrid % fixedrank = 0
-!
-!   Initialization of some fields of the root grid variables
-    ierr_allocate = 0
-    if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate)
-    if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate)
-    if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate)
-    if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate)
-    if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate)
-    if (ierr_allocate /= 0) THEN
-      STOP "*** ERROR WHEN ALLOCATING TABVARS ***"
-    endif
-!
-!   Initialization of the other fields of the root grid variables (number of
-!   cells, positions, number and type of its dimensions, ...)
-    call Agrif_Instance(Agrif_Mygrid)
-    call Agrif_Set_numberofcells(Agrif_Mygrid)
-!
-!   Allocation of the array containing the values of the grid variables
-    call Agrif_Allocation(Agrif_Mygrid, procname2)
-    call Agrif_initialisations(Agrif_Mygrid)
-!
-!   Total number of fixed grids
-    Agrif_nbfixedgrids = 0
-    
-! If a grand mother grid is declared
-
-    if (agrif_coarse) then
-      allocate(Agrif_Coarsegrid)
-
-      Agrif_Coarsegrid % ngridstep = 0
-      Agrif_Coarsegrid % grid_id   = -9999
-      
-    do i = 1, Agrif_Probdim
-        Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i)
-        Agrif_Coarsegrid%timeref(i) = coarse_timeref(i)
-        Agrif_Coarsegrid % ix(i) = 1
-        Agrif_Coarsegrid % Agrif_x(i)  = 0.
-        Agrif_Coarsegrid % Agrif_dx(i) = 1.
-        Agrif_Coarsegrid % Agrif_dt(i) = 1.
-!       Borders of the root coarse grid
-        Agrif_Coarsegrid % NearRootBorder(i) = .true.
-        Agrif_Coarsegrid % DistantRootBorder(i) = .true.
-        Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i)
-    enddo      
-
-!   The root coarse grid is a fixed grid
-    Agrif_Coarsegrid % fixed = .TRUE.
-!   Level of the root grid
-    Agrif_Coarsegrid % level = -1
-    
-    Agrif_Coarsegrid % grand_mother_grid = .true.
-
-!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
-    Agrif_Coarsegrid % rank = -9999
-!
-!   Number of the root grid as a fixed grid
-    Agrif_Coarsegrid % fixedrank = -9999
-    
-      Agrif_Mygrid%parent => Agrif_Coarsegrid
-      
-! Not used but required to prevent seg fault
-      Agrif_Coarsegrid%parent => Agrif_Mygrid
-      
-      call Agrif_Create_Var(Agrif_Coarsegrid)
-
-! Reset to null
-      Nullify(Agrif_Coarsegrid%parent)
-      
-      Agrif_Coarsegrid%child_list%nitems = 1
-      allocate(Agrif_Coarsegrid%child_list%first)
-      allocate(Agrif_Coarsegrid%child_list%last)
-      Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid
-      Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid
-
-    endif
-    
-    return
-
-98  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
-    if (.not. BEXIST) then
-        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
-        STOP
-    else
-        print*,'Error opening file AGRIF_FixedGrids.in'
-        STOP
-    endif
-    
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Init_Grids
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Deallocation
-!
-!> Deallocates all data arrays.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Deallocation
-!---------------------------------------------------------------------------------------------------
-    integer                         :: nb
-    type(Agrif_Variable), pointer   :: var
-    type(Agrif_Variable_c), pointer   :: var_c
-    type(Agrif_Variable_l), pointer   :: var_l
-    type(Agrif_Variable_i), pointer   :: var_i
-!
-    do nb = 1,Agrif_NbVariables(0)
-!
-        var => Agrif_Mygrid % tabvars(nb)
-!
-        if ( allocated(var % array1) ) deallocate(var % array1)
-        if ( allocated(var % array2) ) deallocate(var % array2)
-        if ( allocated(var % array3) ) deallocate(var % array3)
-        if ( allocated(var % array4) ) deallocate(var % array4)
-        if ( allocated(var % array5) ) deallocate(var % array5)
-        if ( allocated(var % array6) ) deallocate(var % array6)
-!
-        if ( allocated(var % sarray1) ) deallocate(var % sarray1)
-        if ( allocated(var % sarray2) ) deallocate(var % sarray2)
-        if ( allocated(var % sarray3) ) deallocate(var % sarray3)
-        if ( allocated(var % sarray4) ) deallocate(var % sarray4)
-        if ( allocated(var % sarray5) ) deallocate(var % sarray5)
-        if ( allocated(var % sarray6) ) deallocate(var % sarray6)
-!
-        if ( allocated(var % darray1) ) deallocate(var % darray1)
-        if ( allocated(var % darray2) ) deallocate(var % darray2)
-        if ( allocated(var % darray3) ) deallocate(var % darray3)
-        if ( allocated(var % darray4) ) deallocate(var % darray4)
-        if ( allocated(var % darray5) ) deallocate(var % darray5)
-        if ( allocated(var % darray6) ) deallocate(var % darray6)
-!
-    enddo
-!
-    do nb = 1,Agrif_NbVariables(1)
-!
-        var_c => Agrif_Mygrid % tabvars_c(nb)
-!
-        if ( allocated(var_c % carray1) ) deallocate(var_c % carray1)
-        if ( allocated(var_c % carray2) ) deallocate(var_c % carray2)
-!
-    enddo
-
-    do nb = 1,Agrif_NbVariables(3)
-!
-        var_l => Agrif_Mygrid % tabvars_l(nb)
-!
-        if ( allocated(var_l % larray1) ) deallocate(var_l % larray1)
-        if ( allocated(var_l % larray2) ) deallocate(var_l % larray2)
-        if ( allocated(var_l % larray3) ) deallocate(var_l % larray3)
-        if ( allocated(var_l % larray4) ) deallocate(var_l % larray4)
-        if ( allocated(var_l % larray5) ) deallocate(var_l % larray5)
-        if ( allocated(var_l % larray6) ) deallocate(var_l % larray6)
-!
-    enddo
-!
-    do nb = 1,Agrif_NbVariables(4)
-!
-        var_i => Agrif_Mygrid % tabvars_i(nb)
-!
-        if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1)
-        if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2)
-        if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3)
-        if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4)
-        if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5)
-        if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6)
-!
-    enddo
-!
-    if ( allocated(Agrif_Mygrid % tabvars) )   deallocate(Agrif_Mygrid % tabvars)
-    if ( allocated(Agrif_Mygrid % tabvars_c) ) deallocate(Agrif_Mygrid % tabvars_c)
-    if ( allocated(Agrif_Mygrid % tabvars_r) ) deallocate(Agrif_Mygrid % tabvars_r)
-    if ( allocated(Agrif_Mygrid % tabvars_l) ) deallocate(Agrif_Mygrid % tabvars_l)
-    if ( allocated(Agrif_Mygrid % tabvars_i) ) deallocate(Agrif_Mygrid % tabvars_i)
-    deallocate(Agrif_Mygrid)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Deallocation
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Step_adj
-!
-!> creates the grid hierarchy and manages the backward time integration procedure.
-!> It is called in the main program.
-!> calls subroutines #Agrif_Regrid and #Agrif_Integrate_adj.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Step_adj ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)    :: procname     !< Subroutine to call on each grid
-!
-!   Creation and initialization of the grid hierarchy
-!
-!   Set the clustering variables
-    call Agrif_clustering_def()
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
-!
-        if (Agrif_Mygrid % ngridstep == 0) then
-            if (.not.Agrif_regrid_has_been_done ) then
-                call Agrif_Regrid()
-            endif
-            call Agrif_Instance(Agrif_Mygrid)
-        endif
-!
-    else
-!
-        if (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
-            call Agrif_Regrid()
-            call Agrif_Instance(Agrif_Mygrid)
-        endif
-!
-    endif
-!
-!   Time integration of the grid hierarchy
-!
-    call Agrif_Integrate_adj (Agrif_Mygrid,procname)
-!
-    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
-!
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Step_adj
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate_adj
-!
-!> Manages the backward time integration of the grid hierarchy.
-!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step_adj
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_adj ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-    type(Agrif_pgrid), pointer :: parcours ! pointer for the recursive procedure
-    integer                    :: nbt      ! Number of time steps of the current grid
-    integer                    :: k
-!
-!   Instanciation of the variables of the current grid
-    if ( g%fixedrank /= 0 ) then
-        call Agrif_Instance(g)
-    endif
-!
-!   Number of time steps on the current grid
-!
-    g%ngridstep = g % ngridstep + 1
-    parcours => g % child_list % first
-!
-!   Recursive procedure for the time integration of the grid hierarchy
-    do while (associated(parcours))
-!
-!   Instanciation of the variables of the current grid
-        call Agrif_Instance(parcours % gr)
-!
-!       Number of time steps
-        nbt = 1
-        do k = 1,Agrif_Probdim
-            nbt = max(nbt, parcours % gr % timeref(k))
-        enddo
-!
-        do k = nbt,1,-1
-            call Agrif_Integrate_adj(parcours % gr, procname)
-        enddo
-!
-        parcours => parcours % next
-!
-    enddo
-!
-    if ( g % child_list % nitems > 0 )  call Agrif_Instance(g)
-!
-!   One step on the current grid
-    call procname ()
-!
-end subroutine Agrif_Integrate_adj
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Step_Child_adj
-!
-!> Apply 'procname' to each grid of the hierarchy from Child to Parent
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Step_Child_adj ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-    call Agrif_Integrate_Child_adj(Agrif_Mygrid,procname)
-!
-    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
-!
-end subroutine Agrif_Step_Child_adj
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate_Child_adj
-!
-!> Manages the backward time integration of the grid hierarchy.
-!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance & Agrif_Step_adj.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_Child_adj ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid),pointer   :: g          !< Pointer on the current grid
-    procedure(step_proc)       :: procname   !< Subroutine to call on each grid
-!
-    type(Agrif_PGrid),pointer  :: parcours   !< Pointer for the recursive procedure
-!
-    parcours => g % child_list % first
-!
-!   Recursive procedure for the time integration of the grid hierarchy
-    do while (associated(parcours))
-!
-!       Instanciation of the variables of the current grid
-        call Agrif_Instance(parcours % gr)
-        call Agrif_Integrate_Child_adj(parcours % gr, procname)
-!
-       parcours => parcours % next
-!
-    enddo
-    if ( g % child_list % nitems > 0 )  call Agrif_Instance(g)
-!
-!   One step on the current grid
-    call procname()
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_Child_adj
-!===================================================================================================
-!
-!===================================================================================================
-
-end module Agrif_Util
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 10251)
@@ -0,0 +1,152 @@
+      Module Agrif_Variables 
+      Use Agrif_CurgridFunctions
+      
+      Contains
+      Subroutine Agrif_Declare_Variable(posvar,firstpoint,
+     &    raf,lb,ub,varid,torestore)
+      character*(80) :: variablename
+      Type(Agrif_List_Variables), Pointer :: newvariable,newvariablep
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: lb,ub
+      INTEGER, DIMENSION(:) :: firstpoint
+      CHARACTER(*) ,DIMENSION(:) :: raf        
+      TYPE(Agrif_Pvariable), Pointer :: parent_var,root_var
+      INTEGER :: dimensio
+      INTEGER :: varid
+      LOGICAL, OPTIONAL :: torestore
+      LOGICAL :: restaure
+            
+!      if (agrif_root()) return
+
+      variablename = 'xxx'
+      
+      restaure = .FALSE.
+      if (agrif_mygrid%ngridstep /= 0) then
+        if (present(torestore)) restaure = torestore
+      endif
+      
+      dimensio = SIZE(posvar)
+C
+C    
+      Allocate(newvariable)
+      Allocate(newvariable%pvar)
+      Allocate(newvariable%pvar%var)
+      Allocate(newvariable%pvar%var%posvar(dimensio))
+      Allocate(newvariable%pvar%var%interptab(dimensio))
+      newvariable%pvar%var%variablename = variablename
+      newvariable%pvar%var%interptab = raf
+      newvariable%pvar%var%nbdim = dimensio
+      newvariable%pvar%var%posvar = posvar
+      newvariable%pvar%var%point(1:dimensio) = firstpoint
+      newvariable%pvar%var%restaure = restaure
+
+      newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio)
+      newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio)
+      
+      if (restaure) then
+      select case(dimensio)
+      case(1)
+                  Allocate( newvariable%pvar%var%Restore1D(  
+     &      lb(1):ub(1)))         
+            newvariable%pvar%var%Restore1D = 0      
+      case(2)
+                  Allocate( newvariable%pvar%var%Restore2D(  
+     &      lb(1):ub(1),lb(2):ub(2)))         
+            newvariable%pvar%var%Restore2D = 0
+      case(3)
+                  Allocate( newvariable%pvar%var%Restore3D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))         
+            newvariable%pvar%var%Restore3D = 0
+      case(4)
+                  Allocate( newvariable%pvar%var%Restore4D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4)))         
+            newvariable%pvar%var%Restore4D = 0
+      case(5)
+                  Allocate( newvariable%pvar%var%Restore5D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),
+     &      lb(5):ub(5)))         
+            newvariable%pvar%var%Restore5D = 0            
+      end select
+      endif
+      
+      newvariable % nextvariable => Agrif_Curgrid%variables
+      
+      Agrif_Curgrid%variables => newvariable
+      Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1
+
+      varid = -Agrif_Curgrid%Nbvariables
+
+!       if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables)
+!     &       then
+!      Allocate(newvariablep)
+!      Allocate(newvariablep%pvar)
+!      Allocate(newvariablep%pvar%var)      
+!      Allocate(newvariablep%pvar%var%posvar(dimensio))
+!      Allocate(newvariablep%pvar%var%interptab(dimensio))
+!      newvariablep%pvar%var%variablename = variablename
+!      newvariablep%pvar%var%interptab = raf
+!      newvariablep%pvar%var%nbdim = dimensio
+!      newvariablep%pvar%var%posvar = posvar
+!      newvariablep%pvar%var%point(1:dimensio) = firstpoint
+!      newvariablep%pvar%var%restaure = restaure      
+! 
+!      newvariablep%pvar%var%lb(1:dimensio) = lb(1:dimensio)
+!      newvariablep%pvar%var%ub(1:dimensio) = ub(1:dimensio)
+!           
+!      newvariablep % nextvariable => Agrif_Curgrid%parent%variables
+!      
+!      Agrif_Curgrid%parent%variables => newvariablep       
+!      
+!      Agrif_Curgrid%parent%Nbvariables = 
+!     &    Agrif_Curgrid%parent%Nbvariables + 1
+!      parent_var=>newvariablep%pvar
+!      else
+!      parent_var=>Agrif_Search_Variable
+!     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)
+!       endif
+       
+       if (.not.agrif_root()) then
+      parent_var=>Agrif_Search_Variable
+     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)       
+       
+       newvariable%pvar%parent_var=>parent_var
+       do i=1,dimensio
+         if (parent_var%var%interptab(i)=='N') then
+           parent_var%var%lb(i)=lb(i)
+           parent_var%var%ub(i)=ub(i)
+         endif
+       enddo
+       endif       
+      
+      root_var=>Agrif_Search_Variable
+     &              (Agrif_Mygrid,Agrif_Curgrid%nbvariables)
+     
+      newvariable%pvar%var%root_var=>root_var%var
+      
+           
+      End Subroutine Agrif_Declare_Variable
+
+      FUNCTION Agrif_Search_Variable(grid,varid)
+      integer :: varid
+      Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable
+      Type(Agrif_grid), Pointer :: grid
+      
+      Type(Agrif_List_Variables), pointer :: parcours
+      Logical :: foundvariable
+      integer nb
+      integer :: varidinv
+      
+      foundvariable = .FALSE.
+      parcours => grid%variables
+      varidinv = 1 + grid%nbvariables - varid
+
+      do nb=1,varidinv-1
+         parcours => parcours%nextvariable    
+      End Do
+      
+      Agrif_Search_variable => parcours%pvar
+      
+      
+      End Function Agrif_Search_variable
+      
+      End Module Agrif_Variables      
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 10250)
+++ 	(revision )
@@ -1,146 +1,0 @@
-module Agrif_Variables
-!
-    use Agrif_CurgridFunctions
-!
-    implicit none
-!
-contains
-!
-!===================================================================================================
-!  subroutine Agrif_Declare_Variable
-!
-!> Declare a new variable profile
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Declare_Variable ( posvar, firstpoint, raf, lb, ub, varid, torestore )
-!---------------------------------------------------------------------------------------------------
-    integer,      dimension(:), intent(in)  :: posvar     !< position of the variable on the cell
-                                                          !! (1 for the border of the edge, 2 for the center)
-    integer,      dimension(:), intent(in)  :: firstpoint !< index of the first point in the real domain
-    character(1), dimension(:), intent(in)  :: raf        !< Array indicating the type of dimension (space or not)
-                                                          !!   for each of them
-    integer,      dimension(:), intent(in)  :: lb         !< Lower bounds of the array
-    integer,      dimension(:), intent(in)  :: ub         !< Upper bounds of the array
-    integer,                    intent(out) :: varid      !< Id number of the newly created variable
-    logical,      optional,     intent(in)  :: torestore  !< Indicates if the array restore is used
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variables_List), pointer :: new_varlist
-    type(Agrif_Variable),       pointer :: var
-    integer                             :: nbdim, i
-    logical                             :: restore
-
-    restore = .FALSE.
-    if ( Agrif_Mygrid % ngridstep /= 0 ) then
-        if (present(torestore)) restore = torestore
-    endif
-!
-    nbdim = SIZE(posvar)
-!
-    allocate(new_varlist)
-    allocate(new_varlist % var)
-
-    var => new_varlist % var
-
-    allocate(var % posvar(nbdim))
-    allocate(var % interptab(nbdim))
-    allocate(var % coords(nbdim))
-!
-    var % nbdim          = nbdim
-    var % interptab      = raf(1:nbdim)
-    var % posvar         = posvar(1:nbdim)
-    var % point(1:nbdim) = firstpoint(1:nbdim)
-    var % restore = restore
-!
-    do i = 1,nbdim
-        select case( raf(i) )
-            case('x')    ; var % coords(i) = 1
-            case('y')    ; var % coords(i) = 2
-            case('z')    ; var % coords(i) = 3
-            case('N')    ; var % coords(i) = 0
-            case default ; var % coords(i) = 0
-        end select
-    enddo
-!
-    var % lb(1:nbdim) = lb(1:nbdim)
-    var % ub(1:nbdim) = ub(1:nbdim)
-
-    if ( restore ) then
-        select case(nbdim)
-        case(1)
-            allocate(var % Restore1D(lb(1):ub(1)))
-            var % Restore1D = 0
-        case(2)
-            allocate(var % Restore2D(lb(1):ub(1),   &
-                                     lb(2):ub(2)))
-            var % Restore2D = 0
-        case(3)
-            allocate(var % Restore3D(lb(1):ub(1),   &
-                                     lb(2):ub(2),   &
-                                     lb(3):ub(3)))
-            var % Restore3D = 0
-        case(4)
-            allocate(var % Restore4D(lb(1):ub(1),   &
-                                     lb(2):ub(2),   &
-                                     lb(3):ub(3),   &
-                                     lb(4):ub(4)))
-            var % Restore4D = 0
-        case(5)
-            allocate(var % Restore5D(lb(1):ub(1),   &
-                                     lb(2):ub(2),   &
-                                     lb(3):ub(3),   &
-                                     lb(4):ub(4),   &
-                                     lb(5):ub(5)))
-            var % Restore5D = 0
-        end select
-    endif
-
-    new_varlist % next => Agrif_Curgrid % variables
-
-    Agrif_Curgrid % variables => new_varlist
-    Agrif_Curgrid % Nbvariables = Agrif_Curgrid % Nbvariables + 1
-
-    varid = -Agrif_Curgrid % Nbvariables
-
-    var % parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, Agrif_Curgrid % nbvariables)
-    var % root_var   => Agrif_Search_Variable(Agrif_Mygrid, Agrif_Curgrid % nbvariables)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Declare_Variable
-!===================================================================================================
-!
-!===================================================================================================
-!  function Agrif_Search_Variable
-!
-!> Returns a pointer to the variable varid for the grid grid.
-!---------------------------------------------------------------------------------------------------
-function Agrif_Search_Variable ( grid, varid ) result(outvar)
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer       :: grid     !< Pointer on the current grid.
-    integer,          intent(in)    :: varid    !< ID number of the variable we are looking for.
-!
-    type(Agrif_Variable),       pointer :: outvar
-    type(Agrif_Variables_List), pointer :: parcours
-    integer :: nb, varidinv
-!
-    if ( .not.associated(grid) ) then
-        outvar => NULL()
-        return
-    endif
-!
-    parcours => grid % variables
-
-    if (.not. associated(parcours)) then   ! can occur on the grand mother grid
-           outvar => NULL()                ! during the first call by agrif_mygrid
-           return
-    endif
-
-    varidinv = 1 + grid % nbvariables - varid
-
-    do nb = 1,varidinv-1
-        parcours => parcours % next
-    enddo
-
-    outvar => parcours % var
-!---------------------------------------------------------------------------------------------------
-end function Agrif_Search_variable
-!===================================================================================================
-!
-end module Agrif_Variables
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 10251)
@@ -69,6 +69,5 @@
       IF( .NOT. ln_limini ) THEN  
          
-         CALL eos_fzp( tsn(:,:,1,jp_sal), tfu(:,:) )       ! freezing/melting point of sea water [Celcius]
-         tfu(:,:) = tfu(:,:) *  tmask(:,:,1)
+         tfu(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius]
 
          DO jj = 1, jpj
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 10251)
@@ -117,6 +117,5 @@
 
       ! basal temperature (considered at freezing point)
-      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
-      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
+      t_bo(:,:) = ( eos_fzp( sss_m(:,:) ) + rt0 ) * tmask(:,:,1) 
 
       IF( ln_iceini ) THEN
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 10251)
@@ -159,5 +159,5 @@
       CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
       CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
-      CALL wrk_alloc( jpi,jpj, zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
 
 #if  defined key_lim2 && ! defined key_lim2_vp
@@ -690,5 +690,5 @@
       CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
       CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
-      CALL wrk_dealloc( jpi,jpj, zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
 
    END SUBROUTINE lim_rhg
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 10251)
@@ -1,64 +1,62 @@
 #if defined key_agrif
-!!----------------------------------------------------------------------
-!! NEMO/NST 3.6 , NEMO Consortium (2010)
-!! $Id$
-!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-!!----------------------------------------------------------------------
-SUBROUTINE Agrif2Model
-   !!---------------------------------------------
-   !!   *** ROUTINE Agrif2Model ***
-   !!--------------------------------------------- 
-END SUBROUTINE Agrif2model
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+   END SUBROUTINE Agrif2model
 
-SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
-   !!---------------------------------------------
-   !!   *** ROUTINE Agrif_Set_numberofcells ***
-   !!--------------------------------------------- 
-   USE Agrif_Grids
-   IMPLICIT NONE
+   SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Set_numberofcells ***
+      !!--------------------------------------------- 
+      USE Agrif_Types
+      IMPLICIT NONE
 
-   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+      Type(Agrif_Grid), Pointer :: Agrif_Gr
 
-   IF ( ASSOCIATED(Agrif_Curgrid) )THEN
+      IF ( associated(Agrif_Curgrid) )THEN
 #include "SetNumberofcells.h"
-   ENDIF
+      ENDIF
 
-END SUBROUTINE Agrif_Set_numberofcells
+   END SUBROUTINE Agrif_Set_numberofcells
 
-SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
-   !!---------------------------------------------
-   !!   *** ROUTINE Agrif_Get_numberofcells ***
-   !!--------------------------------------------- 
-   USE Agrif_Grids
-   IMPLICIT NONE
+   SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Get_numberofcells ***
+      !!--------------------------------------------- 
+      USE Agrif_Types
+      IMPLICIT NONE
 
-   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+      Type(Agrif_Grid), Pointer :: Agrif_Gr
 
-   IF ( ASSOCIATED(Agrif_Curgrid) ) THEN
 #include "GetNumberofcells.h"
-   ENDIF
 
-END SUBROUTINE Agrif_Get_numberofcells
+   END SUBROUTINE Agrif_Get_numberofcells
 
-SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
-   !!---------------------------------------------
-   !!   *** ROUTINE Agrif_Allocationscalls ***
-   !!--------------------------------------------- 
-   USE Agrif_Grids 
+   SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Allocationscalls ***
+      !!--------------------------------------------- 
+      USE Agrif_Types 
 #include "include_use_Alloc_agrif.h"
-   IMPLICIT NONE
+      IMPLICIT NONE
 
-   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+      Type(Agrif_Grid), Pointer :: Agrif_Gr
 
 #include "allocations_calls_agrif.h"
 
-END SUBROUTINE Agrif_Allocationcalls
+   END SUBROUTINE Agrif_Allocationcalls
 
-SUBROUTINE Agrif_probdim_modtype_def()
-   !!---------------------------------------------
-   !!   *** ROUTINE Agrif_probdim_modtype_def ***
-   !!--------------------------------------------- 
-   USE Agrif_Types
-   IMPLICIT NONE
+   SUBROUTINE Agrif_probdim_modtype_def()
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_probdim_modtype_def ***
+      !!--------------------------------------------- 
+      USE Agrif_Types
+      IMPLICIT NONE
 
 #include "modtype_agrif.h"
@@ -66,24 +64,43 @@
 #include "keys_agrif.h"
 
-   RETURN
+      Return
 
-END SUBROUTINE Agrif_probdim_modtype_def
+   END SUBROUTINE Agrif_probdim_modtype_def
 
-SUBROUTINE Agrif_clustering_def()
-   !!---------------------------------------------
-   !!   *** ROUTINE Agrif_clustering_def ***
-   !!--------------------------------------------- 
-   IMPLICIT NONE
+   SUBROUTINE Agrif_clustering_def()
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_clustering_def ***
+      !!--------------------------------------------- 
+      Use Agrif_Types
+      IMPLICIT NONE
 
-   RETURN
+      Return
 
-END SUBROUTINE Agrif_clustering_def
+   END SUBROUTINE Agrif_clustering_def
 
+   SUBROUTINE Agrif_comm_def(modelcomm)
+
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_clustering_def ***
+      !!--------------------------------------------- 
+      Use Agrif_Types
+      Use lib_mpp
+
+      IMPLICIT NONE
+
+      INTEGER :: modelcomm
+
+#if defined key_mpp_mpi
+      modelcomm = mpi_comm_opa
+#endif
+      Return
+
+   END SUBROUTINE Agrif_comm_def
 #else
-SUBROUTINE Agrif2Model
-   !!---------------------------------------------
-   !!   *** ROUTINE Agrif2Model ***
-   !!--------------------------------------------- 
-   WRITE(*,*) 'Impossible to bet here'
-END SUBROUTINE Agrif2model
+   SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+      WRITE(*,*) 'Impossible to bet here'
+   END SUBROUTINE Agrif2model
 #endif
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 10251)
@@ -9,5 +9,5 @@
    !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
    !!----------------------------------------------------------------------
-#if defined key_agrif && defined key_lim2 
+#if defined key_agrif && defined key_lim2
    !!----------------------------------------------------------------------
    !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
@@ -41,8 +41,4 @@
    PUBLIC interp_adv_ice
 
-   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr
-   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr 
-
-
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.4 , NEMO Consortium (2012)
@@ -69,6 +65,6 @@
       u_ice_nst(:,:) = 0.
       v_ice_nst(:,:) = 0.
-      CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. )
-      CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. )
+      CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. )
+      CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. )
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .FALSE.
@@ -142,4 +138,5 @@
       !!  we are in inside a new parent ice time step
       !!-----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice
       INTEGER :: ji,jj
       REAL(wp) :: zrhox, zrhoy
@@ -158,36 +155,33 @@
          Agrif_SpecialValue=-9999.
          Agrif_UseSpecialValue = .TRUE.
-         IF( .NOT. ALLOCATED(uice_agr) )THEN
-            ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj))
-         ENDIF
-         uice_agr = 0.
-         vice_agr = 0.
-         CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.)
-         CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.)
+         zuice = 0.
+         zvice = 0.
+         CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.)
+         CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.)
          Agrif_SpecialValue=0.
          Agrif_UseSpecialValue = .FALSE.
          !  
          zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()      
-         uice_agr(:,:) =  uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
-         vice_agr(:,:) =  vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
+         zuice(:,:) =  zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
+         zvice(:,:) =  zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
          ! fill  boundaries
          DO jj = 1, jpj
             DO ji = 1, 2
-               u_ice_oe(ji,  jj,2) = uice_agr(ji       ,jj) 
-               u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj)
+               u_ice_oe(ji,  jj,2) = zuice(ji       ,jj) 
+               u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj)
             END DO
          END DO
          DO jj = 1, jpj
-            v_ice_oe(2,jj,2) = vice_agr(2     ,jj) 
-            v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj)
+            v_ice_oe(2,jj,2) = zvice(2     ,jj) 
+            v_ice_oe(4,jj,2) = zvice(nlci-1,jj)
          END DO
          DO ji = 1, jpi
-            u_ice_sn(ji,2,2) = uice_agr(ji,2     ) 
-            u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1)
+            u_ice_sn(ji,2,2) = zuice(ji,2     ) 
+            u_ice_sn(ji,4,2) = zuice(ji,nlcj-1)
          END DO
          DO jj = 1, 2
             DO ji = 1, jpi
-               v_ice_sn(ji,jj  ,2) = vice_agr(ji,jj       ) 
-               v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3)
+               v_ice_sn(ji,jj  ,2) = zvice(ji,jj       ) 
+               v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3)
             END DO
          END DO
@@ -340,4 +334,5 @@
       !!  we are in inside a new parent ice time step
      !!-----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
       INTEGER :: ji,jj,jn
       !!-----------------------------------------------------------------------
@@ -350,11 +345,8 @@
          adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2)
          ! interpolation of boundaries
-         IF(.NOT.ALLOCATED(tabice_agr))THEN
-            ALLOCATE(tabice_agr(jpi,jpj,7))   
-         ENDIF
-         tabice_agr(:,:,:) = 0.
+         ztab(:,:,:) = 0.
          Agrif_SpecialValue=-9999.
          Agrif_UseSpecialValue = .TRUE.
-         CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
+         CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
          Agrif_SpecialValue=0.
          Agrif_UseSpecialValue = .FALSE.
@@ -364,6 +356,6 @@
             DO jj = 1, jpj
                DO ji=1,2
-                  adv_ice_oe(ji  ,jj,jn,2) = tabice_agr(ji       ,jj,jn) 
-                  adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn)
+                  adv_ice_oe(ji  ,jj,jn,2) = ztab(ji       ,jj,jn) 
+                  adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn)
                END DO
             END DO
@@ -373,6 +365,6 @@
             Do jj =1,2
                DO ji = 1, jpi
-                  adv_ice_sn(ji,jj  ,jn,2) = tabice_agr(ji,jj       ,jn) 
-                  adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn)
+                  adv_ice_sn(ji,jj  ,jn,2) = ztab(ji,jj       ,jn) 
+                  adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn)
                END DO
             END DO
@@ -392,5 +384,5 @@
       INTEGER :: ji,jj,jn
       REAL(wp) :: zalpha
-      REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr 
+      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
       !!-----------------------------------------------------------------------      
       !
@@ -399,10 +391,10 @@
       zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
       !
-      tabice_agr(:,:,:) = 0.e0
+      ztab(:,:,:) = 0.e0
       DO jn =1,7
          DO jj =1,2
             DO ji = 1, jpi
-               tabice_agr(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
-               tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
+               ztab(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
+               ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
             END DO
          END DO
@@ -412,17 +404,17 @@
          DO jj = 1, jpj
             DO ji=1,2
-               tabice_agr(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
-               tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
-            END DO
-         END DO
-      END DO
-      !
-      CALL parcoursT( tabice_agr(:,:, 1), frld  )
-      CALL parcoursT( tabice_agr(:,:, 2), hicif )
-      CALL parcoursT( tabice_agr(:,:, 3), hsnif )
-      CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) )
-      CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) )
-      CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) )
-      CALL parcoursT( tabice_agr(:,:, 7), qstoif )
+               ztab(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
+               ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
+            END DO
+         END DO
+      END DO
+      !
+      CALL parcoursT( ztab(:,:, 1), frld  )
+      CALL parcoursT( ztab(:,:, 2), hicif )
+      CALL parcoursT( ztab(:,:, 3), hsnif )
+      CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) )
+      CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) )
+      CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) )
+      CALL parcoursT( ztab(:,:, 7), qstoif )
       !
    END SUBROUTINE agrif_trp_lim2
@@ -507,5 +499,5 @@
 
 
-   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before )
+   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 )
       !!-----------------------------------------------------------------------
       !!                     *** ROUTINE interp_u_ice ***
@@ -513,5 +505,4 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji,jj
@@ -519,32 +510,28 @@
       !
 #if defined key_lim2_vp
-      IF( before ) THEN
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               IF( tmu(ji,jj) == 0. ) THEN
-                  tabres(ji,jj) = -9999.
-               ELSE
-                  tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
-               ENDIF
-            END DO
-         END DO
-      ENDIF
+      DO jj=MAX(j1,2),j2
+         DO ji=MAX(i1,2),i2
+            IF( tmu(ji,jj) == 0. ) THEN
+               tabres(ji,jj) = -9999.
+            ELSE
+               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
+            ENDIF
+         END DO
+      END DO
 #else
-      IF( before ) THEN
-         DO jj= j1, j2
-            DO ji= i1, i2
-               IF( umask(ji,jj,1) == 0. ) THEN
-                  tabres(ji,jj) = -9999.
-               ELSE
-                  tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
-               ENDIF
-            END DO
-         END DO
-      ENDIF
+      DO jj= j1, j2
+         DO ji= i1, i2
+            IF( umask(ji,jj,1) == 0. ) THEN
+               tabres(ji,jj) = -9999.
+            ELSE
+               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
+            ENDIF
+         END DO
+      END DO
 #endif
    END SUBROUTINE interp_u_ice
 
 
-   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before )
+   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 )
       !!-----------------------------------------------------------------------
       !!                    *** ROUTINE interp_v_ice ***
@@ -552,5 +539,4 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji, jj
@@ -558,32 +544,28 @@
       !
 #if defined key_lim2_vp
-      IF( before ) THEN
-         DO jj=MAX(j1,2),j2
-            DO ji=MAX(i1,2),i2
-               IF( tmu(ji,jj) == 0. ) THEN
-                  tabres(ji,jj) = -9999.
-               ELSE
-                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
-               ENDIF
-            END DO
-         END DO
-      ENDIF   
+      DO jj=MAX(j1,2),j2
+         DO ji=MAX(i1,2),i2
+            IF( tmu(ji,jj) == 0. ) THEN
+               tabres(ji,jj) = -9999.
+            ELSE
+               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
+            ENDIF
+         END DO
+      END DO
 #else
-      IF( before ) THEN
-	      DO jj= j1 ,j2
-	         DO ji = i1, i2
-	            IF( vmask(ji,jj,1) == 0. ) THEN
-	               tabres(ji,jj) = -9999.
-	            ELSE
-	               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
-	            ENDIF
-	         END DO
-	      END DO
-      ENDIF
+      DO jj= j1 ,j2
+         DO ji = i1, i2
+            IF( vmask(ji,jj,1) == 0. ) THEN
+               tabres(ji,jj) = -9999.
+            ELSE
+               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
+            ENDIF
+         END DO
+      END DO
 #endif
    END SUBROUTINE interp_v_ice
 
 
-   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before )
+   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 )
       !!-----------------------------------------------------------------------
       !!                    *** ROUTINE interp_adv_ice ***                           
@@ -595,26 +577,23 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji, jj, jk
       !!-----------------------------------------------------------------------
       !
-      IF( before ) THEN
-	      DO jj=j1,j2
-	         DO ji=i1,i2
-	            IF( tms(ji,jj) == 0. ) THEN
-	               tabres(ji,jj,:) = -9999. 
-	            ELSE
-	               tabres(ji,jj, 1) = frld  (ji,jj)
-	               tabres(ji,jj, 2) = hicif (ji,jj)
-	               tabres(ji,jj, 3) = hsnif (ji,jj)
-	               tabres(ji,jj, 4) = tbif  (ji,jj,1)
-	               tabres(ji,jj, 5) = tbif  (ji,jj,2)
-	               tabres(ji,jj, 6) = tbif  (ji,jj,3)
-	               tabres(ji,jj, 7) = qstoif(ji,jj)
-	            ENDIF
-	         END DO
-	      END DO
-      ENDIF
+      DO jj=j1,j2
+         DO ji=i1,i2
+            IF( tms(ji,jj) == 0. ) THEN
+               tabres(ji,jj,:) = -9999. 
+            ELSE
+               tabres(ji,jj, 1) = frld  (ji,jj)
+               tabres(ji,jj, 2) = hicif (ji,jj)
+               tabres(ji,jj, 3) = hsnif (ji,jj)
+               tabres(ji,jj, 4) = tbif  (ji,jj,1)
+               tabres(ji,jj, 5) = tbif  (ji,jj,2)
+               tabres(ji,jj, 6) = tbif  (ji,jj,3)
+               tabres(ji,jj, 7) = qstoif(ji,jj)
+            ENDIF
+         END DO
+      END DO
       !
    END SUBROUTINE interp_adv_ice
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 10251)
@@ -52,4 +52,6 @@
       INTEGER, INTENT(in) :: kt
       !!
+      REAL(wp), DIMENSION(jpi,jpj)  :: zvel
+      REAL(wp), DIMENSION(jpi,jpj,7):: zadv
       !!----------------------------------------------------------------------
       !
@@ -58,13 +60,14 @@
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
+
 # if defined TWO_WAY
       IF( MOD(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  )
-         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
-         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
-      ELSE
-         CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
-         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
-         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
+         CALL Agrif_Update_Variable( zadv , adv_ice_id , procname = update_adv_ice  )
+         CALL Agrif_Update_Variable( zvel , u_ice_id   , procname = update_u_ice    )
+         CALL Agrif_Update_Variable( zvel , v_ice_id   , procname = update_v_ice    )
+      ELSE
+         CALL Agrif_Update_Variable( zadv , adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
+         CALL Agrif_Update_Variable( zvel , u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
+         CALL Agrif_Update_Variable( zvel , v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
       ENDIF
 # endif
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 10251)
@@ -12,5 +12,5 @@
    USE par_oce      ! ocean parameters
    USE dom_oce      ! domain parameters
-
+   
    IMPLICIT NONE
    PRIVATE 
@@ -19,10 +19,8 @@
 
    !                                              !!* Namelist namagrif: AGRIF parameters
-   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !:
-   INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency 
-   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points)
-   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers
-   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics
-   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry 
+   LOGICAL , PUBLIC ::   ln_spc_dyn      !:
+   INTEGER , PUBLIC ::   nn_cln_update   !: update frequency 
+   REAL(wp), PUBLIC ::   rn_sponge_tra   !: sponge coeff. for tracers
+   REAL(wp), PUBLIC ::   rn_sponge_dyn   !: sponge coeff. for dynamics
 
    !                                              !!! OLD namelist names
@@ -32,42 +30,16 @@
    REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics
 
-   LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator
-   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator
-   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE.     !: if true: first step
-   LOGICAL , PUBLIC :: lk_agrif_doupd = .TRUE.     !: if true: send update from current grid
-   LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE.    !: if true: print debugging info
+   LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator
+   LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator
+   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step
 
-   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_tsn
-# if defined key_top
-   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_trn
-# endif
-   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u
-   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities
-
-   ! Barotropic arrays used to store open boundary data during
-   ! time-splitting loop:
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s
-
-   INTEGER :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update
-   INTEGER :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations
-   INTEGER :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates
-   INTEGER :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers
-# if defined key_top
-   INTEGER :: trn_id, trn_sponge_id
-# endif  
-   INTEGER :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id
-   INTEGER :: ub2b_update_id, vb2b_update_id
-   INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id
-   INTEGER :: scales_t_id
-# if defined key_zdftke
-   INTEGER :: avt_id, avm_id, en_id
-# endif  
-   INTEGER :: umsk_id, vmsk_id
-   INTEGER :: kindic_agr
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ???
+   
+   INTEGER :: tsn_id,tsb_id,tsa_id
+   INTEGER :: un_id, vn_id, ua_id, va_id
+   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id
+   INTEGER :: trn_id, trb_id, tra_id
+   INTEGER :: unb_id, vnb_id, ub2b_id, vb2b_id
 
    !!----------------------------------------------------------------------
@@ -82,24 +54,6 @@
       !!                ***  FUNCTION agrif_oce_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(2) :: ierr
-      !!----------------------------------------------------------------------
-      ierr(:) = 0
-      !
-      ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),   &
-         &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),   &
-         &      tabspongedone_tsn(jpi,jpj),           &
-# if defined key_top         
-         &      tabspongedone_trn(jpi,jpj),           &
-# endif         
-         &      tabspongedone_u  (jpi,jpj),           &
-         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) )
-
-      ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj),   &
-         &      ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj),   & 
-         &      ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi),   & 
-         &      ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi), STAT = ierr(2) )
-
-      agrif_oce_alloc = MAXVAL(ierr)
-      !
+      ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      &
+         &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc ) 
    END FUNCTION agrif_oce_alloc
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 10251)
@@ -7,5 +7,4 @@
    !!             -   !  2005-11  (XXX) 
    !!            3.2  !  2009-04  (R. Benshila) 
-   !!            3.6  !  2014-09  (R. Benshila) 
    !!----------------------------------------------------------------------
 #if defined key_agrif && ! defined key_offline
@@ -30,42 +29,139 @@
    USE wrk_nemo
    USE dynspg_oce
-   USE zdf_oce
- 
+
    IMPLICIT NONE
    PRIVATE
 
-   INTEGER :: bdy_tinterp = 0
-
+   ! Barotropic arrays used to store open boundary data during
+   ! time-splitting loop:
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s
+    
    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
-   PUBLIC   interpun, interpvn, interpun2d, interpvn2d 
-   PUBLIC   interptsn,  interpsshn
-   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
-   PUBLIC   interpe3t, interpumsk, interpvmsk
-# if defined key_zdftke
-   PUBLIC   Agrif_tke, interpavm
-# endif
+   PUBLIC   interpu, interpv, interpunb, interpvnb, interpsshn
 
 #  include "domzgr_substitute.h90"  
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.6 , NEMO Consortium (2010)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
-CONTAINS
-
+   CONTAINS
+   
    SUBROUTINE Agrif_tra
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_tra  ***
+      !!                  ***  ROUTINE Agrif_Tra  ***
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3
+      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa
       !!----------------------------------------------------------------------
       !
       IF( Agrif_Root() )   RETURN
 
+      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa ) 
+
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-
-      CALL Agrif_Bc_variable( tsn_id, procname=interptsn )
+      ztsa(:,:,:,:) = 0.e0
+
+      CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn )
       Agrif_UseSpecialValue = .FALSE.
+
+      zrhox = Agrif_Rhox()
+
+      alpha1 = ( zrhox - 1. ) * 0.5
+      alpha2 = 1. - alpha1
+
+      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+      alpha4 = 1. - alpha3
+
+      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+      alpha5 = 1. - alpha6 - alpha7
+
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+
+         DO jn = 1, jpts
+            tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                     tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                  ELSE
+                     tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                        tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  &
+                           &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO
+      ENDIF
+
+      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
+
+         DO jn = 1, jpts
+            tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn)
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                     tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                  ELSE
+                     tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                        tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  &
+                           &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO 
+      ENDIF
+
+      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+         DO jn = 1, jpts
+            tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  IF( umask(2,jj,jk) == 0.e0 ) THEN
+                     tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
+                  ELSE
+                     tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
+                     IF( un(2,jj,jk) < 0.e0 ) THEN
+                        tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
+         DO jn = 1, jpts
+            tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn)
+            DO jk=1,jpk      
+               DO ji=1,jpi
+                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                     tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
+                  ELSE
+                     tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
+                     IF( vn(ji,2,jk) < 0.e0 ) THEN
+                        tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsa ) 
       !
    END SUBROUTINE Agrif_tra
@@ -79,27 +175,16 @@
       INTEGER, INTENT(in) ::   kt
       !!
-      INTEGER :: ji,jj,jk, j1,j2, i1,i2
+      INTEGER :: ji,jj,jk
       REAL(wp) :: timeref
       REAL(wp) :: z2dt, znugdt
       REAL(wp) :: zrhox, zrhoy
-      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva
+      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d
       !!----------------------------------------------------------------------  
 
       IF( Agrif_Root() )   RETURN
 
-      CALL wrk_alloc( jpi, jpj, spgv1, spgu1 )
-
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = ln_spc_dyn
-
-      CALL Agrif_Bc_variable(un_interp_id,procname=interpun)
-      CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn)
-
-#if defined key_dynspg_flt
-      CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d)
-      CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d)
-#endif
-
-      Agrif_UseSpecialValue = .FALSE.
+      CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
+      CALL wrk_alloc( jpi, jpj, jpk, zua, zva )
 
       zrhox = Agrif_Rhox()
@@ -107,4 +192,5 @@
 
       timeref = 1.
+
       ! time step: leap-frog
       z2dt = 2. * rdt
@@ -114,19 +200,41 @@
       znugdt =  grav * z2dt    
 
-      ! prevent smoothing in ghost cells
-      i1=1
-      i2=jpi
-      j1=1
-      j2=jpj
-      IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3
-      IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2
-      IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3
-      IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+
+      zua = 0.
+      zva = 0.
+      CALL Agrif_Bc_variable(zua,un_id,procname=interpu)
+      CALL Agrif_Bc_variable(zva,vn_id,procname=interpv)
+      zua2d = 0.
+      zva2d = 0.
+
+#if defined key_dynspg_flt
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+      CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d)
+      CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d)
+#endif
+      Agrif_UseSpecialValue = .FALSE.
 
 
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
+
 #if defined key_dynspg_flt
-         DO jk=1,jpkm1
-            DO jj=j1,j2
+         DO jj=1,jpj
+            laplacu(2,jj) = timeref * (zua2d(2,jj)/(zrhoy*e2u(2,jj)))*umask(2,jj,1)
+         END DO
+#endif
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(zrhoy*e2u(1:2,jj)))
+               ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u_a(1:2,jj,jk)
+            END DO
+         END DO
+
+#if defined key_dynspg_flt
+         DO jk=1,jpkm1
+            DO jj=1,jpj
                ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk)
             END DO
@@ -137,5 +245,5 @@
          DO jk=1,jpkm1
             DO jj=1,jpj
-               spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
+               spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
             END DO
          END DO
@@ -143,5 +251,5 @@
          DO jj=1,jpj
             IF (umask(2,jj,1).NE.0.) THEN
-               spgu(2,jj)=spgu(2,jj)/hu(2,jj)
+               spgu(2,jj)=spgu(2,jj)*hur_a(2,jj)
             ENDIF
          END DO
@@ -151,5 +259,5 @@
 
          DO jk=1,jpkm1
-            DO jj=j1,j2
+            DO jj=1,jpj
                ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk))
                ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
@@ -161,5 +269,5 @@
          DO jk=1,jpkm1
             DO jj=1,jpj
-               spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
+               spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
             END DO
          END DO
@@ -167,11 +275,18 @@
          DO jj=1,jpj
             IF (umask(2,jj,1).NE.0.) THEN
-               spgu1(2,jj)=spgu1(2,jj)/hu(2,jj)
+               spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj)
             ENDIF
          END DO
 
          DO jk=1,jpkm1
-            DO jj=j1,j2
+            DO jj=1,jpj
                ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               va(2,jj,jk) = (zva(2,jj,jk)/(zrhox*e1v(2,jj)))*vmask(2,jj,jk)
+               va(2,jj,jk) = va(2,jj,jk) / fse3v_a(2,jj,jk)
             END DO
          END DO
@@ -185,7 +300,9 @@
             END DO
          END DO
+
          DO jj=1,jpj
             spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj)
          END DO
+
          DO jk=1,jpkm1
             DO jj=1,jpj
@@ -199,18 +316,35 @@
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
 #if defined key_dynspg_flt
-         DO jk=1,jpkm1
-            DO jj=j1,j2
+         DO jj=1,jpj
+            laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)))
+         END DO
+#endif
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(zrhoy*e2u(nlci-2:nlci-1,jj)))
+               ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u_a(nlci-2:nlci-1,jj,jk)
+            END DO
+         END DO
+
+#if defined key_dynspg_flt
+         DO jk=1,jpkm1
+            DO jj=1,jpj
                ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk)
             END DO
          END DO
+
+
          spgu(nlci-2,:)=0.
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)
-            ENDDO
-         ENDDO
+
+         do jk=1,jpkm1
+            do jj=1,jpj
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)
+            enddo
+         enddo
+
          DO jj=1,jpj
             IF (umask(nlci-2,jj,1).NE.0.) THEN
-               spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj)
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)*hur_a(nlci-2,jj)
             ENDIF
          END DO
@@ -218,6 +352,7 @@
          spgu(nlci-2,:) = ua_b(nlci-2,:)
 #endif
-         DO jk=1,jpkm1
-            DO jj=j1,j2
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
                ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk))
 
@@ -226,18 +361,29 @@
             END DO
          END DO
+
          spgu1(nlci-2,:)=0.
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)
-            END DO
-         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)
+            END DO
+         END DO
+
          DO jj=1,jpj
             IF (umask(nlci-2,jj,1).NE.0.) THEN
-               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj)
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj)
             ENDIF
          END DO
-         DO jk=1,jpkm1
-            DO jj=j1,j2
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
                ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj-1
+               va(nlci-1,jj,jk) = (zva(nlci-1,jj,jk)/(zrhox*e1v(nlci-1,jj)))*vmask(nlci-1,jj,jk)
+               va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v_a(nlci-1,jj,jk)
             END DO
          END DO
@@ -268,4 +414,17 @@
 
 #if defined key_dynspg_flt
+         DO ji=1,jpi
+            laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))
+         END DO
+#endif
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2)))
+               va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v_a(ji,1:2,jk)
+            END DO
+         END DO
+
+#if defined key_dynspg_flt
          DO jk=1,jpkm1
             DO ji=1,jpi
@@ -278,5 +437,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)
+               spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)
             END DO
          END DO
@@ -284,5 +443,5 @@
          DO ji=1,jpi
             IF (vmask(ji,2,1).NE.0.) THEN
-               spgv(ji,2)=spgv(ji,2)/hv(ji,2)
+               spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2)
             ENDIF
          END DO
@@ -292,5 +451,5 @@
 
          DO jk=1,jpkm1
-            DO ji=i1,i2
+            DO ji=1,jpi
                va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk))
                va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk)
@@ -302,5 +461,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
+               spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
             END DO
          END DO
@@ -308,5 +467,5 @@
          DO ji=1,jpi
             IF (vmask(ji,2,1).NE.0.) THEN
-               spgv1(ji,2)=spgv1(ji,2)/hv(ji,2)
+               spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2)
             ENDIF
          END DO
@@ -315,4 +474,11 @@
             DO ji=1,jpi
                va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               ua(ji,2,jk) = (zua(ji,2,jk)/(zrhoy*e2u(ji,2)))*umask(ji,2,jk) 
+               ua(ji,2,jk) = ua(ji,2,jk) / fse3u_a(ji,2,jk)
             END DO
          END DO
@@ -342,4 +508,17 @@
 
 #if defined key_dynspg_flt
+         DO ji=1,jpi
+            laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)))
+         END DO
+#endif
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,nlcj-2:nlcj-1,jk) = (zva(ji,nlcj-2:nlcj-1,jk)/(zrhox*e1v(ji,nlcj-2:nlcj-1)))
+               va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v_a(ji,nlcj-2:nlcj-1,jk)
+            END DO
+         END DO
+
+#if defined key_dynspg_flt
          DO jk=1,jpkm1
             DO ji=1,jpi
@@ -348,10 +527,9 @@
          END DO
 
-
          spgv(:,nlcj-2)=0.
 
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
             END DO
          END DO
@@ -359,8 +537,7 @@
          DO ji=1,jpi
             IF (vmask(ji,nlcj-2,1).NE.0.) THEN
-               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2)
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2)
             ENDIF
          END DO
-
 #else
          spgv(:,nlcj-2)=va_b(:,nlcj-2)
@@ -368,5 +545,5 @@
 
          DO jk=1,jpkm1
-            DO ji=i1,i2
+            DO ji=1,jpi
                va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk))
                va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
@@ -378,5 +555,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
             END DO
          END DO
@@ -384,5 +561,5 @@
          DO ji=1,jpi
             IF (vmask(ji,nlcj-2,1).NE.0.) THEN
-               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2)
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2)
             ENDIF
          END DO
@@ -391,4 +568,11 @@
             DO ji=1,jpi
                va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(zrhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk)
+               ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u_a(ji,nlcj-1,jk)
             END DO
          END DO
@@ -416,5 +600,6 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 )
+      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
+      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva )
       !
    END SUBROUTINE Agrif_dyn
@@ -435,9 +620,9 @@
          DO jj=1,jpj
             va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj)
-            ! Specified fluxes:
+! Specified fluxes:
             ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj)
-            ! Characteristics method:
-            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
-            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
+! Characteristics method:
+!alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
+!alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
          END DO
       ENDIF
@@ -446,9 +631,9 @@
          DO jj=1,jpj
             va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)
-            ! Specified fluxes:
+! Specified fluxes:
             ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)
-            ! Characteristics method:
-            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
-            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
+! Characteristics method:
+!alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
+!alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
          END DO
       ENDIF
@@ -457,9 +642,9 @@
          DO ji=1,jpi
             ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2)
-            ! Specified fluxes:
+! Specified fluxes:
             va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2)
-            ! Characteristics method:
-            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
-            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
+! Characteristics method:
+!alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
+!alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
          END DO
       ENDIF
@@ -468,9 +653,9 @@
          DO ji=1,jpi
             ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1)
-            ! Specified fluxes:
+! Specified fluxes:
             va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)
-            ! Characteristics method:
-            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
-            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
+! Characteristics method:
+!alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
+!alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
          END DO
       ENDIF
@@ -487,5 +672,9 @@
       INTEGER :: ji, jj
       LOGICAL :: ll_int_cons
-      REAL(wp) :: zrhot, zt
+      REAL(wp) :: zrhox, zrhoy, zrhot, zt
+      REAL(wp) :: zaa, zab, zat
+      REAL(wp) :: zt0, zt1
+      REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn
+      REAL(wp), POINTER, DIMENSION(:,:) :: zuab, zvab, zubb, zvbb, zutn, zvtn
       !!----------------------------------------------------------------------  
 
@@ -493,7 +682,18 @@
 
       ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in
-      ! the forward case only
-
+                             ! the forward case only
+
+      zrhox = Agrif_Rhox()
+      zrhoy = Agrif_Rhoy()
       zrhot = Agrif_rhot()
+
+      IF ( kt==nit000 ) THEN ! Allocate boundary data arrays
+         ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj))
+         ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj))
+         ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi))
+         ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi))
+      ENDIF
+
+      CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn )
 
       ! "Central" time index for interpolation:
@@ -507,5 +707,5 @@
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-      CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn )
+      CALL Agrif_Bc_variable(zsshn, sshn_id,calledweight=zt, procname=interpsshn )
       Agrif_UseSpecialValue = .FALSE.
 
@@ -515,24 +715,96 @@
 
       IF (ll_int_cons) THEN ! Conservative interpolation
-         ! orders matters here !!!!!!
-         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated
-         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1._wp, procname=interpvb2b)
-         bdy_tinterp = 1
-         CALL Agrif_Bc_variable(unb_id ,calledweight=1._wp, procname=interpunb) ! After
-         CALL Agrif_Bc_variable(vnb_id ,calledweight=1._wp, procname=interpvnb)
-         bdy_tinterp = 2
-         CALL Agrif_Bc_variable(unb_id ,calledweight=0._wp, procname=interpunb) ! Before
-         CALL Agrif_Bc_variable(vnb_id ,calledweight=0._wp, procname=interpvnb)         
+         CALL wrk_alloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn )
+         zuab(:,:) = 0._wp ; zvab(:,:) = 0._wp
+         zubb(:,:) = 0._wp ; zvbb(:,:) = 0._wp
+         zutn(:,:) = 0._wp ; zvtn(:,:) = 0._wp
+         CALL Agrif_Bc_variable(zubb,unb_id ,calledweight=0._wp, procname=interpunb) ! Before
+         CALL Agrif_Bc_variable(zvbb,vnb_id ,calledweight=0._wp, procname=interpvnb)
+         CALL Agrif_Bc_variable(zuab,unb_id ,calledweight=1._wp, procname=interpunb) ! After
+         CALL Agrif_Bc_variable(zvab,vnb_id ,calledweight=1._wp, procname=interpvnb)
+         CALL Agrif_Bc_variable(zutn,ub2b_id,calledweight=1._wp, procname=interpub2b)! Time integrated
+         CALL Agrif_Bc_variable(zvtn,vb2b_id,calledweight=1._wp, procname=interpvb2b)
+         
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
+
+         ! Polynomial interpolation coefficients:
+         zaa = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                 &      - zt0**2._wp * (       zt0 - 1._wp)        )
+         zab = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                 &      - zt0        * (       zt0 - 1._wp)**2._wp )
+         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        &
+                 &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
+
+         ! Do time interpolation
+         IF((nbondi == -1).OR.(nbondi == 2)) THEN
+            DO jj=1,jpj
+               zunb(2,jj) = zaa * zuab(2,jj) + zab * zubb(2,jj) + zat * zutn(2,jj)
+               zvnb(2,jj) = zaa * zvab(2,jj) + zab * zvbb(2,jj) + zat * zvtn(2,jj)
+            END DO
+         ENDIF
+         IF((nbondi == 1).OR.(nbondi == 2)) THEN
+            DO jj=1,jpj
+               zunb(nlci-2,jj) = zaa * zuab(nlci-2,jj) + zab * zubb(nlci-2,jj) + zat * zutn(nlci-2,jj)
+               zvnb(nlci-1,jj) = zaa * zvab(nlci-1,jj) + zab * zvbb(nlci-1,jj) + zat * zvtn(nlci-1,jj)
+            END DO
+         ENDIF
+         IF((nbondj == -1).OR.(nbondj == 2)) THEN
+            DO ji=1,jpi
+               zunb(ji,2) = zaa * zuab(ji,2) + zab * zubb(ji,2) + zat * zutn(ji,2)
+               zvnb(ji,2) = zaa * zvab(ji,2) + zab * zvbb(ji,2) + zat * zvtn(ji,2)
+            END DO
+         ENDIF
+         IF((nbondj == 1).OR.(nbondj == 2)) THEN
+            DO ji=1,jpi
+               zunb(ji,nlcj-1) = zaa * zuab(ji,nlcj-1) + zab * zubb(ji,nlcj-1) + zat * zutn(ji,nlcj-1)
+               zvnb(ji,nlcj-2) = zaa * zvab(ji,nlcj-2) + zab * zvbb(ji,nlcj-2) + zat * zvtn(ji,nlcj-2)
+            END DO
+         ENDIF
+         CALL wrk_dealloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn )
+
       ELSE ! Linear interpolation
-         bdy_tinterp = 0
-         ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 
-         ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 
-         ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 
-         ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 
-         CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb)
-         CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb)
+         zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp
+         CALL Agrif_Bc_variable(zunb,unb_id,calledweight=zt, procname=interpunb)
+         CALL Agrif_Bc_variable(zvnb,vnb_id,calledweight=zt, procname=interpvnb)
       ENDIF
       Agrif_UseSpecialValue = .FALSE.
-      ! 
+
+      ! Fill boundary data arrays:
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+               ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) * umask(2,jj,1)
+               vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) * vmask(2,jj,1)
+               hbdy_w(jj) = zsshn(2,jj) * tmask(2,jj,1)
+         END DO
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+               ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) * umask(nlci-2,jj,1)
+               vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) * vmask(nlci-1,jj,1)
+               hbdy_e(jj) = zsshn(nlci-1,jj) * tmask(nlci-1,jj,1)
+         END DO
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+               ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) * umask(ji,2,1)
+               vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) * vmask(ji,2,1)
+               hbdy_s(ji) = zsshn(ji,2) * tmask(ji,2,1)
+         END DO
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) * umask(ji,nlcj-1,1)
+            vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) * vmask(ji,nlcj-2,1)
+            hbdy_n(ji) = zsshn(ji,nlcj-1) * tmask(ji,nlcj-1,1)
+         END DO
+      ENDIF
+
+      CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn )
+
    END SUBROUTINE Agrif_dta_ts
 
@@ -546,4 +818,5 @@
 
       IF( Agrif_Root() )   RETURN
+
 
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
@@ -554,5 +827,5 @@
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
          ssha(nlci-1,:)=ssha(nlci-2,:)
-         sshn(nlci-1,:)=sshn(nlci-2,:)
+         sshn(nlci-1,:)=sshn(nlci-2,:)        
       ENDIF
 
@@ -564,5 +837,5 @@
       IF((nbondj == 1).OR.(nbondj == 2)) THEN
          ssha(:,nlcj-1)=ssha(:,nlcj-2)
-         sshn(:,nlcj-1)=sshn(:,nlcj-2)
+         sshn(:,nlcj-1)=sshn(:,nlcj-2)                
       ENDIF
 
@@ -604,738 +877,171 @@
    END SUBROUTINE Agrif_ssh_ts
 
-# if defined key_zdftke
-   SUBROUTINE Agrif_tke
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_tke  ***
-      !!----------------------------------------------------------------------  
-      REAL(wp) ::   zalpha
-      !
-      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp )
-      IF( zalpha > 1. )   zalpha = 1.
-      
-      Agrif_SpecialValue    = 0.e0
-      Agrif_UseSpecialValue = .TRUE.
-      
-      CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)       
-              
-      Agrif_UseSpecialValue = .FALSE.
-      !
-   END SUBROUTINE Agrif_tke
-# endif
-
-   SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
-      !!---------------------------------------------
-      !!   *** ROUTINE interptsn ***
-      !!---------------------------------------------
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
-      !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER :: imin, imax, jmin, jmax
-      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
-      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
-
-      IF (before) THEN         
-         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
-      ELSE
-         !
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         !
-         zrhox = Agrif_Rhox()
-         ! 
-         zalpha1 = ( zrhox - 1. ) * 0.5
-         zalpha2 = 1. - zalpha1
-         ! 
-         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha4 = 1. - zalpha3
-         ! 
-         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-         zalpha5 = 1. - zalpha6 - zalpha7
-         !
-         imin = i1
-         imax = i2
-         jmin = j1
-         jmax = j2
-         ! 
-         ! Remove CORNERS
-         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
-         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
-         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
-         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
-         !
-         IF( eastern_side) THEN
-            DO jn = 1, jpts
-               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                     ELSE
-                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 
-                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         ! 
-         IF( northern_side ) THEN            
-            DO jn = 1, jpts
-               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO ji = imin,imax
-                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                     ELSE
-                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  &
-                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         !
-         IF( western_side) THEN            
-            DO jn = 1, jpts
-               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(2,jj,jk) == 0.e0 ) THEN
-                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
-                     ELSE
-                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
-                        IF( un(2,jj,jk) < 0.e0 ) THEN
-                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         !
-         IF( southern_side ) THEN           
-            DO jn = 1, jpts
-               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
-               DO jk=1,jpk      
-                  DO ji=imin,imax
-                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
-                     ELSE
-                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
-                        IF( vn(ji,2,jk) < 0.e0 ) THEN
-                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         !
-         ! Treatment of corners
-         ! 
-         ! East south
-         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
-         ENDIF
-         ! East north
-         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
-         ENDIF
-         ! West south
-         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tsa(2,2,:,:) = ptab(2,2,:,:)
-         ENDIF
-         ! West north
-         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
-         ENDIF
-         !
-      ENDIF
-      !
-   END SUBROUTINE interptsn
-
-   SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir)
+   SUBROUTINE interpsshn(tabres,i1,i2,j1,j2)
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE interpsshn  ***
       !!----------------------------------------------------------------------  
       INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
-      !!----------------------------------------------------------------------  
-      !
-      IF( before) THEN
-         ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
-      ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
-         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
-         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
-         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
-      ENDIF
-      !
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+
+      tabres(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
+
    END SUBROUTINE interpsshn
 
-   SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpun ***
-      !!---------------------------------------------    
-      !!
+   SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpu  ***
+      !!----------------------------------------------------------------------  
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
       !!
       INTEGER :: ji,jj,jk
-      REAL(wp) :: zrhoy	
-      !!---------------------------------------------    
-      !
-      IF (before) THEN 
-         DO jk=1,jpk
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
-                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE
-         zrhoy = Agrif_Rhoy()
-         DO jk=1,jpkm1
-            DO jj=j1,j2
-               ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj)))
-               ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk)
-            END DO
-         END DO
-      ENDIF
-      ! 
-   END SUBROUTINE interpun
-
-
-   SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpun ***
-      !!---------------------------------------------    
-      !
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      !
-      INTEGER :: ji,jj
-      REAL(wp) :: ztref
-      REAL(wp) :: zrhoy	
-      !!---------------------------------------------    
-      !
-      ztref = 1.
-
-      IF (before) THEN 
-         DO jj=j1,j2
-            DO ji=i1,MIN(i2,nlci-1)
-               ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) 
-            END DO
-         END DO
-      ELSE
-         zrhoy = Agrif_Rhoy()
-         DO jj=j1,j2
-            laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1)
-         END DO
-      ENDIF
-      ! 
-   END SUBROUTINE interpun2d
-
-
-   SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpvn ***
-      !!---------------------------------------------    
-      !
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      !
-      INTEGER :: ji,jj,jk
-      REAL(wp) :: zrhox	
-      !!---------------------------------------------    
-      !      
-      IF (before) THEN          
-         !interpv entre 1 et k2 et interpv2d en jpkp1
-         DO jk=k1,jpk
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
-                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE          
-         zrhox= Agrif_Rhox()
-         DO jk=1,jpkm1
-            DO jj=j1,j2
-               va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj)))
-               va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk)
-            END DO
-         END DO
-      ENDIF
-      !        
-   END SUBROUTINE interpvn
-
-   SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpvn ***
-      !!---------------------------------------------    
-      !
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      !
-      INTEGER :: ji,jj
-      REAL(wp) :: zrhox	
-      REAL(wp) :: ztref
-      !!---------------------------------------------    
-      ! 
-      ztref = 1.    
-      IF (before) THEN 
-         !interpv entre 1 et k2 et interpv2d en jpkp1
-         DO jj=j1,MIN(j2,nlcj-1)
-            DO ji=i1,i2
-               ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1)
-            END DO
-         END DO
-      ELSE           
-         zrhox = Agrif_Rhox()
-         DO ji=i1,i2
-            laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2)))
-         END DO
-      ENDIF
-      !      
-   END SUBROUTINE interpvn2d
-
-   SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpunb  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
-      !!
-      INTEGER :: ji,jj
-      REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
-      !!----------------------------------------------------------------------  
-      !
-      IF (before) THEN 
+      !!----------------------------------------------------------------------  
+
+      DO jk=k1,k2
          DO jj=j1,j2
             DO ji=i1,i2
-               ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 
-            END DO
-         END DO
-      ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         zrhoy = Agrif_Rhoy()
-         zrhot = Agrif_rhot()
-         ! Time indexes bounds for integration
-         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
-         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
-         ! Polynomial interpolation coefficients:
-         IF( bdy_tinterp == 1 ) THEN
-            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
-                  &      - zt0**2._wp * (       zt0 - 1._wp)        )
-         ELSEIF( bdy_tinterp == 2 ) THEN
-            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
-                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
-
-         ELSE
-            ztcoeff = 1
-         ENDIF
-         !   
-         IF(western_side) THEN
-            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(eastern_side) THEN
-            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(southern_side) THEN
-            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
-         IF(northern_side) THEN
-            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
-         !            
-         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
-            IF(western_side) THEN
-               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2))   &
-                     &                                  * umask(i1,j1:j2,1)
-            ENDIF
-            IF(eastern_side) THEN
-               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2))   &
-                     &                                  * umask(i1,j1:j2,1)
-            ENDIF
-            IF(southern_side) THEN
-               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1))   &
-                     &                                  * umask(i1:i2,j1,1)
-            ENDIF
-            IF(northern_side) THEN
-               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1))   &
-                     &                                  * umask(i1:i2,j1,1)
-            ENDIF
-         ENDIF
-      ENDIF
-      ! 
-   END SUBROUTINE interpunb
-
-   SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpvnb  ***
+               tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
+               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+   END SUBROUTINE interpu
+
+
+   SUBROUTINE interpu2d(tabres,i1,i2,j1,j2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpu2d  ***
       !!----------------------------------------------------------------------  
       INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       !!
       INTEGER :: ji,jj
-      REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff   
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
-      !!----------------------------------------------------------------------  
-      ! 
-      IF (before) THEN 
+      !!----------------------------------------------------------------------  
+
+      DO jj=j1,j2
+         DO ji=i1,i2
+            tabres(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) &
+               * umask(ji,jj,1)
+         END DO
+      END DO
+
+   END SUBROUTINE interpu2d
+
+
+   SUBROUTINE interpv(tabres,i1,i2,j1,j2,k1,k2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpv  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji, jj, jk
+      !!----------------------------------------------------------------------  
+
+      DO jk=k1,k2
          DO jj=j1,j2
             DO ji=i1,i2
-               ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj) 
-            END DO
-         END DO
-      ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         zrhox = Agrif_Rhox()
-         zrhot = Agrif_rhot()
-         ! Time indexes bounds for integration
-         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
-         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
-         IF( bdy_tinterp == 1 ) THEN
-            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
-                  &      - zt0**2._wp * (       zt0 - 1._wp)        )
-         ELSEIF( bdy_tinterp == 2 ) THEN
-            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
-                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
-
-         ELSE
-            ztcoeff = 1
-         ENDIF
-         !
-         IF(western_side) THEN
-            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(eastern_side) THEN
-            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
-         ENDIF
-         IF(southern_side) THEN
-            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
-         ENDIF
-         IF(northern_side) THEN
-            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
-         ENDIF
-         !            
-         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
-            IF(western_side) THEN
-               vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
-                     &                                  * vmask(i1,j1:j2,1)
-            ENDIF
-            IF(eastern_side) THEN
-               vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
-                     &                                  * vmask(i1,j1:j2,1)
-            ENDIF
-            IF(southern_side) THEN
-               vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
-                     &                                  * vmask(i1:i2,j1,1)
-            ENDIF
-            IF(northern_side) THEN
-               vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
-                     &                                  * vmask(i1:i2,j1,1)
-            ENDIF
-         ENDIF
-      ENDIF
-      !
+               tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
+               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE interpv
+
+
+   SUBROUTINE interpv2d(tabres,i1,i2,j1,j2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpu2d  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+
+      DO jj=j1,j2
+         DO ji=i1,i2
+            tabres(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) &
+               * vmask(ji,jj,1)
+         END DO
+      END DO
+
+   END SUBROUTINE interpv2d
+
+   SUBROUTINE interpunb(tabres,i1,i2,j1,j2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpunb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+
+      DO jj=j1,j2
+         DO ji=i1,i2
+            tabres(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 
+         END DO
+      END DO
+
+   END SUBROUTINE interpunb
+
+   SUBROUTINE interpvnb(tabres,i1,i2,j1,j2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvnb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+
+      DO jj=j1,j2
+         DO ji=i1,i2
+            tabres(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj)
+         END DO
+      END DO
+
    END SUBROUTINE interpvnb
 
-   SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir)
+   SUBROUTINE interpub2b(tabres,i1,i2,j1,j2)
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE interpub2b  ***
       !!----------------------------------------------------------------------  
       INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       !!
       INTEGER :: ji,jj
-      REAL(wp) :: zrhot, zt0, zt1,zat
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
-      !!----------------------------------------------------------------------  
-      IF( before ) THEN
-         DO jj=j1,j2
-            DO ji=i1,i2
-               ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj)
-            END DO
-         END DO
-      ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         zrhot = Agrif_rhot()
-         ! Time indexes bounds for integration
-         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
-         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
-         ! Polynomial interpolation coefficients:
-         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        &
-               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
-         ! 
-         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
-         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
-      ENDIF
-      ! 
+      !!----------------------------------------------------------------------  
+
+      DO jj=j1,j2
+         DO ji=i1,i2
+            tabres(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj)
+         END DO
+      END DO
+
    END SUBROUTINE interpub2b
 
-   SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir)
+   SUBROUTINE interpvb2b(tabres,i1,i2,j1,j2)
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE interpvb2b  ***
       !!----------------------------------------------------------------------  
       INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       !!
       INTEGER :: ji,jj
-      REAL(wp) :: zrhot, zt0, zt1,zat
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
-      !!----------------------------------------------------------------------  
-      !
-      IF( before ) THEN
-         DO jj=j1,j2
-            DO ji=i1,i2
-               ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj)
-            END DO
-         END DO
-      ELSE      
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         zrhot = Agrif_rhot()
-         ! Time indexes bounds for integration
-         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
-         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
-         ! Polynomial interpolation coefficients:
-         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        &
-               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
-         !
-         IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
-         IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
-         IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
-      ENDIF
-      !      
+      !!----------------------------------------------------------------------  
+
+      DO jj=j1,j2
+         DO ji=i1,i2
+            tabres(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj)
+         END DO
+      END DO
+
    END SUBROUTINE interpvb2b
-
-   SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpe3t  ***
-      !!----------------------------------------------------------------------  
-      ! 
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL :: before
-      INTEGER, INTENT(in) :: nb , ndir
-      !
-      INTEGER :: ji, jj, jk
-      LOGICAL :: western_side, eastern_side, northern_side, southern_side
-      REAL(wp) :: ztmpmsk      
-      !!----------------------------------------------------------------------  
-      !    
-      IF (before) THEN
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  ! Get velocity mask at boundary edge points:
-                  IF (western_side)  ztmpmsk = umask(ji    ,jj    ,1)
-                  IF (eastern_side)  ztmpmsk = umask(nlci-2,jj    ,1)
-                  IF (northern_side) ztmpmsk = vmask(ji    ,nlcj-2,1)
-                  IF (southern_side) ztmpmsk = vmask(ji    ,2     ,1)
-
-                  IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN
-                     IF (western_side) THEN
-                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                     ELSEIF (eastern_side) THEN
-                        WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                     ELSEIF (southern_side) THEN
-                        WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
-                     ELSEIF (northern_side) THEN
-                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
-                     ENDIF
-                     WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk)
-                     kindic_agr = kindic_agr + 1
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-      ENDIF
-      ! 
-   END SUBROUTINE interpe3t
-
-   SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpumsk  ***
-      !!----------------------------------------------------------------------  
-      ! 
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL :: before
-      INTEGER, INTENT(in) :: nb , ndir
-      !
-      INTEGER :: ji, jj, jk
-      LOGICAL :: western_side, eastern_side   
-      !!----------------------------------------------------------------------  
-      !    
-      IF (before) THEN
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  ptab(ji,jj,jk) = umask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE
-
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                   ! Velocity mask at boundary edge points:
-                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN
-                     IF (western_side) THEN
-                        WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ELSEIF (eastern_side) THEN
-                        WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-      ENDIF
-      ! 
-   END SUBROUTINE interpumsk
-
-   SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpvmsk  ***
-      !!----------------------------------------------------------------------  
-      ! 
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL :: before
-      INTEGER, INTENT(in) :: nb , ndir
-      !
-      INTEGER :: ji, jj, jk
-      LOGICAL :: northern_side, southern_side     
-      !!----------------------------------------------------------------------  
-      !    
-      IF (before) THEN
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  ptab(ji,jj,jk) = vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE
-
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                   ! Velocity mask at boundary edge points:
-                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN
-                     IF (southern_side) THEN
-                        WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ELSEIF (northern_side) THEN
-                        WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
-                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
-                        kindic_agr = kindic_agr + 1
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-      ENDIF
-      ! 
-   END SUBROUTINE interpvmsk
-
-# if defined key_zdftke
-
-   SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interavm  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      !!----------------------------------------------------------------------  
-      !      
-      IF( before) THEN
-         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
-      ELSE
-         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
-      ENDIF
-      !
-   END SUBROUTINE interpavm
-
-# endif /* key_zdftke */
 
 #else
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 10251)
@@ -1,5 +1,5 @@
 #define SPONGE && define SPONGE_TOP
 
-MODULE agrif_opa_sponge
+Module agrif_opa_sponge
 #if defined key_agrif  && ! defined key_offline
    USE par_oce
@@ -9,13 +9,11 @@
    USE agrif_oce
    USE wrk_nemo  
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
-   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
-
-   !! * Substitutions
+   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn
+
+  !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
@@ -25,5 +23,5 @@
    !!----------------------------------------------------------------------
 
-CONTAINS
+   CONTAINS
 
    SUBROUTINE Agrif_Sponge_Tra
@@ -32,17 +30,55 @@
       !!---------------------------------------------
       !!
+      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
+      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
+      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff
 
 #if defined SPONGE
+      CALL wrk_alloc( jpi, jpj, ztu, ztv )
+      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
+
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
-      CALL Agrif_Sponge
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      tabspongedone_tsn = .FALSE.
-
-      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
-
+      ztab = 0.e0
+      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn)
       Agrif_UseSpecialValue = .FALSE.
+
+      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:)
+
+      CALL Agrif_Sponge
+
+      DO jn = 1, jpts
+         DO jk = 1, jpkm1
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
+                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+                  ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+               ENDDO
+            ENDDO
+
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+                  ! horizontal diffusive trends
+                  ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   &
+                  &              + ztv(ji,jj) - ztv(ji  ,jj-1)  )
+                  ! add it to the general tracer trends
+                  tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
+               END DO
+            END DO
+            !
+         ENDDO
+      ENDDO
+
+      CALL wrk_dealloc( jpi, jpj, ztu, ztv )
+      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
 #endif
 
@@ -54,21 +90,89 @@
       !!---------------------------------------------
       !!
+      INTEGER :: ji,jj,jk
       REAL(wp) :: timecoeff
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
 
 #if defined SPONGE
+      CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
+
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = ln_spc_dyn
-
-      tabspongedone_u = .FALSE.
-      tabspongedone_v = .FALSE.         
-      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)
-
-      tabspongedone_u = .FALSE.
-      tabspongedone_v = .FALSE.
-      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)
-
+      ztab = 0.e0
+      CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun)
       Agrif_UseSpecialValue = .FALSE.
+
+      ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:)
+
+      ztab = 0.e0
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+      CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn)
+      Agrif_UseSpecialValue = .FALSE.
+
+      vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:)
+
+      CALL Agrif_Sponge
+
+      DO jk = 1,jpkm1
+         ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:)
+         vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:)
+      ENDDO
+      
+      hdivdiff = 0.
+      rotdiff = 0.
+
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         !                                             ! --------
+         ! Horizontal divergence                       !   div
+         !                                             ! --------
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+               hdivdiff(ji,jj,jk) =  (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * ubdiff(ji  ,jj  ,jk)     &
+                  &                   - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * ubdiff(ji-1,jj  ,jk)     &
+                  &                   + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * vbdiff(ji  ,jj  ,jk)     &
+                  &                   - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * vbdiff(ji  ,jj-1,jk)  ) * zbtr
+            END DO
+         END DO
+
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk)
+               rotdiff(ji,jj,jk) = (  e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)    &
+                  &                 - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) &
+                  &               * fmask(ji,jj,jk) * zbtr
+            END DO
+         END DO
+
+      ENDDO
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               ! horizontal diffusive trends
+               zua = - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                     + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk) ) / e1u(ji,jj)
+
+               zva = + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                     + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) / e2v(ji,jj)
+               ! add it to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
 #endif
 
@@ -95,10 +199,11 @@
          CALL wrk_alloc( jpi, jpj, ztabramp )
 
-         ispongearea  = 2 + nn_sponge_len * Agrif_irhox()
+         ispongearea  = 2 + 2 * Agrif_irhox()
          ilci = nlci - ispongearea
          ilcj = nlcj - ispongearea 
          z1spongearea = 1._wp / REAL( ispongearea - 2 )
-
-         ztabramp(:,:) = 0._wp
+         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+
+         ztabramp(:,:) = 0.
 
          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
@@ -149,15 +254,54 @@
       ! Tracers
       IF( .NOT. spongedoneT ) THEN
-         fsaht_spu(:,:) = 0._wp
-         fsaht_spv(:,:) = 0._wp
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  ))
-               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1))
-            END DO
-         END DO
-
-         CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( fsaht_spv, 'V', 1. )
+         spe1ur(:,:) = 0.
+         spe2vr(:,:) = 0.
+
+         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            spe1ur(2:ispongearea-1,:       ) = visc_tra                                        &
+               &                             *    0.5 * (  ztabramp(2:ispongearea-1,:      )   &
+               &                                         + ztabramp(3:ispongearea  ,:      ) ) &
+               &                             * e2u(2:ispongearea-1,:) / e1u(2:ispongearea-1,:)
+
+            spe2vr(2:ispongearea  ,1:jpjm1 ) = visc_tra                                        &
+               &                             *    0.5 * (  ztabramp(2:ispongearea  ,1:jpjm1)   &
+               &                                         + ztabramp(2:ispongearea,2  :jpj  ) ) &
+               &                             * e1v(2:ispongearea,1:jpjm1) / e2v(2:ispongearea,1:jpjm1)
+         ENDIF
+
+         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            spe1ur(ilci+1:nlci-2,:        ) = visc_tra                                   &
+               &                            * 0.5 * (  ztabramp(ilci+1:nlci-2,:      )   & 
+               &                                     + ztabramp(ilci+2:nlci-1,:      ) ) &
+               &                            * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:)
+
+            spe2vr(ilci+1:nlci-1,1:jpjm1  )  = visc_tra                                  &
+               &                            * 0.5 * (  ztabramp(ilci+1:nlci-1,1:jpjm1)   & 
+               &                                     + ztabramp(ilci+1:nlci-1,2:jpj  ) ) & 
+               &                            * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1)
+         ENDIF
+
+         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
+            spe1ur(1:jpim1,2:ispongearea  ) = visc_tra                                     &
+               &                            * 0.5 * (  ztabramp(1:jpim1,2:ispongearea  )   & 
+               &                                     + ztabramp(2:jpi  ,2:ispongearea  ) ) &
+               &                            * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea)
+   
+            spe2vr(:      ,2:ispongearea-1) = visc_tra                                     &
+               &                            * 0.5 * (  ztabramp(:      ,2:ispongearea-1)   &
+               &                                     + ztabramp(:      ,3:ispongearea  ) ) &
+               &                            * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1)
+         ENDIF
+
+         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
+            spe1ur(1:jpim1,ilcj+1:nlcj-1) = visc_tra                                   &
+               &                          * 0.5 * (  ztabramp(1:jpim1,ilcj+1:nlcj-1)   &
+               &                                   + ztabramp(2:jpi  ,ilcj+1:nlcj-1) ) &
+               &                                * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1)
+
+            spe2vr(:      ,ilcj+1:nlcj-2) = visc_tra                                   &
+               &                          * 0.5 * (  ztabramp(:      ,ilcj+1:nlcj-2)   &
+               &                                   + ztabramp(:      ,ilcj+2:nlcj-1) ) &
+               &                                * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2)
+         ENDIF
          spongedoneT = .TRUE.
       ENDIF
@@ -165,17 +309,44 @@
       ! Dynamics
       IF( .NOT. spongedoneU ) THEN
-         fsahm_spt(:,:) = 0._wp
-         fsahm_spf(:,:) = 0._wp
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj)
-               fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) &
-                                                     &  +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
-            END DO
-         END DO
-
-         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( fsahm_spf, 'F', 1. )
+         spe1ur2(:,:) = 0.
+         spe2vr2(:,:) = 0.
+
+         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            spe1ur2(2:ispongearea-1,:      ) = visc_dyn                                   &
+               &                             * 0.5 * (  ztabramp(2:ispongearea-1,:      ) &
+               &                                      + ztabramp(3:ispongearea  ,:      ) )
+            spe2vr2(2:ispongearea  ,1:jpjm1) = visc_dyn                                   &
+               &                             * 0.5 * (  ztabramp(2:ispongearea  ,1:jpjm1) &
+               &                                      + ztabramp(2:ispongearea  ,2:jpj  ) ) 
+         ENDIF
+
+         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            spe1ur2(ilci+1:nlci-2  ,:      ) = visc_dyn                                   &
+               &                             * 0.5 * (  ztabramp(ilci+1:nlci-2, :       ) &
+               &                                      + ztabramp(ilci+2:nlci-1, :       ) )                      
+            spe2vr2(ilci+1:nlci-1  ,1:jpjm1) = visc_dyn                                   &
+               &                             * 0.5 * (  ztabramp(ilci+1:nlci-1,1:jpjm1  ) &
+               &                                      + ztabramp(ilci+1:nlci-1,2:jpj    ) ) 
+         ENDIF
+
+         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
+            spe1ur2(1:jpim1,2:ispongearea  ) = visc_dyn                                   &  
+               &                             * 0.5 * (  ztabramp(1:jpim1,2:ispongearea  ) &
+               &                                      + ztabramp(2:jpi  ,2:ispongearea  ) ) 
+            spe2vr2(:      ,2:ispongearea-1) = visc_dyn                                   &
+               &                             * 0.5 * (  ztabramp(:      ,2:ispongearea-1) &
+               &                                      + ztabramp(:      ,3:ispongearea  ) )
+         ENDIF
+
+         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
+            spe1ur2(1:jpim1,ilcj+1:nlcj-1  ) = visc_dyn                                   &
+               &                             * 0.5 * (  ztabramp(1:jpim1,ilcj+1:nlcj-1  ) &
+               &                                      + ztabramp(2:jpi  ,ilcj+1:nlcj-1  ) ) 
+            spe2vr2(:      ,ilcj+1:nlcj-2  ) = visc_dyn                                   &
+               &                             * 0.5 * (  ztabramp(:      ,ilcj+1:nlcj-2  ) &
+               &                                      + ztabramp(:      ,ilcj+2:nlcj-1  ) )
+         ENDIF
          spongedoneU = .TRUE.
+         spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) )
       ENDIF
       !
@@ -186,277 +357,36 @@
    END SUBROUTINE Agrif_Sponge
 
-   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
-      !!---------------------------------------------
-      !!   *** ROUTINE interptsn_sponge ***
+   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-
-
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER  ::   iku, ikv
-      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff
-      !
-      IF (before) THEN
-         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
-      ELSE   
-   
-         tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)    
-         DO jn = 1, jpts            
-            DO jk = 1, jpkm1
-               DO jj = j1,j2-1
-                  DO ji = i1,i2-1
-                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
-                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
-                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
-                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
-                  ENDDO
-               ENDDO
-
-               IF( ln_zps ) THEN      ! set gradient at partial step level
-                  DO jj = j1,j2-1
-                     DO ji = i1,i2-1
-                        ! last level
-                        iku = mbku(ji,jj)
-                        ikv = mbkv(ji,jj)
-                        IF( iku == jk ) THEN
-                           ztu(ji,jj,jk) = 0._wp
-                        ENDIF
-                        IF( ikv == jk ) THEN
-                           ztv(ji,jj,jk) = 0._wp
-                        ENDIF
-                     END DO
-                  END DO
-               ENDIF
-            ENDDO
-
-            DO jk = 1, jpkm1
-               DO jj = j1+1,j2-1
-                  DO ji = i1+1,i2-1
-
-                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 
-                        zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk)
-                        ! horizontal diffusive trends
-                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  )
-                        ! add it to the general tracer trends
-                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
-                     ENDIF
-
-                  ENDDO
-               ENDDO
-
-            ENDDO
-         ENDDO
-
-         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
-
-      ENDIF
-
-   END SUBROUTINE interptsn_sponge
-
-   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpun_sponge ***
-      !!---------------------------------------------    
+
+      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+
+   END SUBROUTINE interptsn
+
+   SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-
-      INTEGER :: ji,jj,jk
-
-      ! sponge parameters 
-      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
-      INTEGER :: jmax
-      !
-
-
-      IF (before) THEN
-         tabres = un(i1:i2,j1:j2,:)
-      ELSE
-
-         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:)
-
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-
-            !                                             ! --------
-            ! Horizontal divergence                       !   div
-            !                                             ! --------
-            DO jj = j1,j2
-               DO ji = i1+1,i2   ! vector opt.
-                  zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
-                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) &
-                                     &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr
-               END DO
-            END DO
-
-            DO jj = j1,j2-1
-               DO ji = i1,i2   ! vector opt.
-                  zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
-                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) &
-                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) & 
-                                    & ) * fmask(ji,jj,jk) * zbtr 
-               END DO
-            END DO
-         ENDDO
-
-         !
-
-
-
-         DO jj = j1+1, j2-1
-            DO ji = i1+1, i2-1   ! vector opt.
-
-               IF (.NOT. tabspongedone_u(ji,jj)) THEN
-                  DO jk = 1, jpkm1                                 ! Horizontal slab
-                     ze2u = rotdiff (ji,jj,jk)
-                     ze1v = hdivdiff(ji,jj,jk)
-                     ! horizontal diffusive trends
-                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) )   &
-                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj)
-
-                     ! add it to the general momentum trends
-                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-
-                  END DO
-               ENDIF
-
-            END DO
-         END DO
-
-         tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE.
-
-         jmax = j2-1
-         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3)
-
-         DO jj = j1+1, jmax
-            DO ji = i1+1, i2   ! vector opt.
-
-               IF (.NOT. tabspongedone_v(ji,jj)) THEN
-                  DO jk = 1, jpkm1                                 ! Horizontal slab
-                     ze2u = rotdiff (ji,jj,jk)
-                     ze1v = hdivdiff(ji,jj,jk)
-
-                     ! horizontal diffusive trends
-                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) )   &
-                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj)
-
-                     ! add it to the general momentum trends
-                     va(ji,jj,jk) = va(ji,jj,jk) + zva
-                  END DO
-               ENDIF
-
-            END DO
-         END DO
-
-
-         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE.
-
-      ENDIF
-
-
-   END SUBROUTINE interpun_sponge
-
-
-   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpvn_sponge ***
-      !!--------------------------------------------- 
+
+      tabres(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2)
+
+   END SUBROUTINE interpun
+
+   SUBROUTINE interpvn(tabres,i1,i2,j1,j2,k1,k2)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
-
-      INTEGER :: ji,jj,jk
-
-      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
-
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
-      INTEGER :: imax
-      !
-
-      IF (before) THEN 
-         tabres = vn(i1:i2,j1:j2,:)
-      ELSE
-
-         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:)
-
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-
-            !                                             ! --------
-            ! Horizontal divergence                       !   div
-            !                                             ! --------
-            DO jj = j1+1,j2
-               DO ji = i1,i2   ! vector opt.
-                  zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
-                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  &
-                                     &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr
-               END DO
-            END DO
-            DO jj = j1,j2
-               DO ji = i1,i2-1   ! vector opt.
-                  zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
-                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 
-                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) &
-                                    & ) * fmask(ji,jj,jk) * zbtr
-               END DO
-            END DO
-         ENDDO
-
-         !                                                ! ===============
-         !                                                
-
-         imax = i2-1
-         IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3)
-
-         DO jj = j1+1, j2
-            DO ji = i1+1, imax   ! vector opt.
-               IF (.NOT. tabspongedone_u(ji,jj)) THEN
-                  DO jk = 1, jpkm1                                 ! Horizontal slab
-                     ze2u = rotdiff (ji,jj,jk)
-                     ze1v = hdivdiff(ji,jj,jk)
-                     ! horizontal diffusive trends
-                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) &
-                           / e1u(ji,jj)
-
-
-                     ! add it to the general momentum trends
-                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-                  END DO
-
-               ENDIF
-            END DO
-         END DO
-
-         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE.
-
-         DO jj = j1+1, j2-1
-            DO ji = i1+1, i2-1   ! vector opt.
-               IF (.NOT. tabspongedone_v(ji,jj)) THEN
-                  DO jk = 1, jpkm1                                 ! Horizontal slab
-                     ze2u = rotdiff (ji,jj,jk)
-                     ze1v = hdivdiff(ji,jj,jk)
-                     ! horizontal diffusive trends
-
-                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) &
-                           / e2v(ji,jj)
-
-                     ! add it to the general momentum trends
-                     va(ji,jj,jk) = va(ji,jj,jk) + zva
-                  END DO
-               ENDIF
-            END DO
-         END DO
-         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE.
-      ENDIF
-
-   END SUBROUTINE interpvn_sponge
+
+      tabres(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2)
+
+   END SUBROUTINE interpvn
 
 #else
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 10251)
@@ -1,5 +1,4 @@
-#define TWO_WAY        /* TWO WAY NESTING */
-#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/
- 
+#define TWO_WAY
+
 MODULE agrif_opa_update
 #if defined key_agrif  && ! defined key_offline
@@ -12,15 +11,14 @@
    USE wrk_nemo  
    USE dynspg_oce
-   USE zdf_oce        ! vertical physics: ocean variables 
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales
-# if defined key_zdftke
-   PUBLIC Agrif_Update_Tke
-# endif
+   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn
+
+   INTEGER, PUBLIC :: nbcline = 0
+
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.6 , NEMO Consortium (2010)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -29,151 +27,98 @@
 CONTAINS
 
-   RECURSIVE SUBROUTINE Agrif_Update_Tra( )
+   SUBROUTINE Agrif_Update_Tra( kt )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Tra ***
       !!---------------------------------------------
-      ! 
-      IF (Agrif_Root()) RETURN
-      !
-#if defined TWO_WAY  
-      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed(), 'nbcline', nbcline
+      !!
+      INTEGER, INTENT(in) :: kt
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
+
+
+      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+#if defined TWO_WAY
+      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab )
 
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-      ! 
+
       IF (MOD(nbcline,nbclineupdate) == 0) THEN
-# if ! defined DECAL_FEEDBACK
-         CALL Agrif_Update_Variable(tsn_id, procname=updateTS)
-# else
-         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS)
-# endif
-      ELSE
-# if ! defined DECAL_FEEDBACK
-         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS)
-# else
-         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS)
-# endif
-      ENDIF
-      !
+         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS)
+      ELSE
+         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS)
+      ENDIF
+
       Agrif_UseSpecialValueInUpdate = .FALSE.
-      !
-      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:
-         CALL Agrif_ChildGrid_To_ParentGrid()
-         CALL Agrif_Update_Tra()
-         CALL Agrif_ParentGrid_To_ChildGrid()
-      ENDIF
-      !
+
+      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab )
 #endif
-      !
+
    END SUBROUTINE Agrif_Update_Tra
 
-   RECURSIVE SUBROUTINE Agrif_Update_Dyn( )
+   SUBROUTINE Agrif_Update_Dyn( kt )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Dyn ***
       !!---------------------------------------------
-      ! 
-      IF (Agrif_Root()) RETURN
-      !
+      !!
+      INTEGER, INTENT(in) :: kt
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
+
+
+      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return
 #if defined TWO_WAY
-      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline
-
-      Agrif_UseSpecialValueInUpdate = .FALSE.
-      Agrif_SpecialValueFineGrid = 0.
-      !     
+      CALL wrk_alloc( jpi, jpj,      ztab2d )
+      CALL wrk_alloc( jpi, jpj, jpk, ztab   )
+
       IF (mod(nbcline,nbclineupdate) == 0) THEN
-# if ! defined DECAL_FEEDBACK
-         CALL Agrif_Update_Variable(un_update_id,procname = updateU)
-         CALL Agrif_Update_Variable(vn_update_id,procname = updateV)
-# else
-         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU)
-         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV)
-# endif
-      ELSE
-# if ! defined DECAL_FEEDBACK
-         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU)
-         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)         
-# else
-         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU)
-         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV)
-# endif
-      ENDIF
-
-# if ! defined DECAL_FEEDBACK
-      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
-      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)  
-# else
-      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d)
-      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)  
-# endif
-
-# if defined key_dynspg_ts
+         CALL Agrif_Update_Variable(ztab,un_id,procname = updateU)
+         CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV)
+      ELSE
+         CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU)
+         CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV)         
+      ENDIF
+
+      CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d)
+      CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d)
+
+#if defined key_dynspg_ts
       IF (ln_bt_fw) THEN
          ! Update time integrated transports
          IF (mod(nbcline,nbclineupdate) == 0) THEN
-#  if ! defined DECAL_FEEDBACK
-            CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b)
-            CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b)
-#  else
-            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b)
-            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b)
-#  endif
+            CALL Agrif_Update_Variable(ztab2d,ub2b_id,procname = updateub2b)
+            CALL Agrif_Update_Variable(ztab2d,vb2b_id,procname = updatevb2b)
          ELSE
-#  if ! defined DECAL_FEEDBACK
-            CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b)
-            CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b)
-#  else
-            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b)
-            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b)
-#  endif
+            CALL Agrif_Update_Variable(ztab2d,ub2b_id,locupdate=(/0,1/),procname = updateub2b)
+            CALL Agrif_Update_Variable(ztab2d,vb2b_id,locupdate=(/0,1/),procname = updatevb2b)
          ENDIF
-      END IF
-# endif
-      !
+      END IF 
+#endif
+
       nbcline = nbcline + 1
-      !
-      Agrif_UseSpecialValueInUpdate = .TRUE.
+
+      Agrif_UseSpecialValueInUpdate = .TRUE. 
       Agrif_SpecialValueFineGrid = 0.
-# if ! defined DECAL_FEEDBACK
-      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH)
-# else
-      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH)
-# endif
+      CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH)
       Agrif_UseSpecialValueInUpdate = .FALSE.
-      ! 
+
+      CALL wrk_dealloc( jpi, jpj,      ztab2d )
+      CALL wrk_dealloc( jpi, jpj, jpk, ztab   )
+
+!Done in step
+!      CALL Agrif_ChildGrid_To_ParentGrid()
+!      CALL recompute_diags( kt )
+!      CALL Agrif_ParentGrid_To_ChildGrid()
+
 #endif
-      !
-      ! Do recursive update:
-      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:
-         CALL Agrif_ChildGrid_To_ParentGrid()
-         CALL Agrif_Update_Dyn()
-         CALL Agrif_ParentGrid_To_ChildGrid()
-      ENDIF
-      !
+
    END SUBROUTINE Agrif_Update_Dyn
 
-# if defined key_zdftke
-   SUBROUTINE Agrif_Update_Tke( kt )
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Update_Tke ***
-      !!---------------------------------------------
-      !!
+   SUBROUTINE recompute_diags( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE recompute_diags ***
+      !!---------------------------------------------
       INTEGER, INTENT(in) :: kt
-      !       
-      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN
-#  if defined TWO_WAY
-
-      Agrif_UseSpecialValueInUpdate = .TRUE.
-      Agrif_SpecialValueFineGrid = 0.
-
-      CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  )
-      CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT )
-      CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM )
-
-      Agrif_UseSpecialValueInUpdate = .FALSE.
-
-#  endif
-      
-   END SUBROUTINE Agrif_Update_Tke
-# endif /* key_zdftke */
+
+   END SUBROUTINE recompute_diags
 
    SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
@@ -182,11 +127,11 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
+
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
-      !!
+      LOGICAL, iNTENT(in) :: before
+
       INTEGER :: ji,jj,jk,jn
-      !!---------------------------------------------
-      !
+
       IF (before) THEN
          DO jn = n1,n2
@@ -201,5 +146,5 @@
       ELSE
          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
-            ! Add asselin part
+         ! Add asselin part
             DO jn = n1,n2
                DO jk=k1,k2
@@ -208,6 +153,6 @@
                         IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
                            tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 
-                                 & + atfp * ( tabres(ji,jj,jk,jn) &
-                                 &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                              & + atfp * ( tabres(ji,jj,jk,jn) &
+                              &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
@@ -216,4 +161,5 @@
             ENDDO
          ENDIF
+
          DO jn = n1,n2
             DO jk=k1,k2
@@ -228,5 +174,5 @@
          END DO
       ENDIF
-      ! 
+
    END SUBROUTINE updateTS
 
@@ -236,13 +182,12 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-      !!
+
       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-      !! 
+
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhoy
-      !!---------------------------------------------
-      ! 
+
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -264,5 +209,5 @@
                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
                      ub(ji,jj,jk) = ub(ji,jj,jk) & 
-                           & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
+                       & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
                   ENDIF
                   !
@@ -272,5 +217,5 @@
          END DO
       ENDIF
-      ! 
+
    END SUBROUTINE updateu
 
@@ -280,13 +225,12 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-      !!
+
       INTEGER :: i1,i2,j1,j2,k1,k2
       INTEGER :: ji,jj,jk
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres
       LOGICAL :: before
-      !!
+
       REAL(wp) :: zrhox
-      !!---------------------------------------------      
-      !
+
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -308,5 +252,5 @@
                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
                      vb(ji,jj,jk) = vb(ji,jj,jk) & 
-                           & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
+                       & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
                   ENDIF
                   !
@@ -316,5 +260,5 @@
          END DO
       ENDIF
-      ! 
+
    END SUBROUTINE updatev
 
@@ -324,14 +268,13 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-      !!
+
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-      !! 
+
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhoy
       REAL(wp) :: zcorr
-      !!---------------------------------------------
-      !
+
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -383,5 +326,5 @@
          END DO
       ENDIF
-      !
+
    END SUBROUTINE updateu2d
 
@@ -390,13 +333,13 @@
       !!          *** ROUTINE updatev2d ***
       !!---------------------------------------------
+
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-      !! 
+
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhox
       REAL(wp) :: zcorr
-      !!---------------------------------------------
-      !
+
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -448,19 +391,19 @@
          END DO
       ENDIF
-      ! 
+
    END SUBROUTINE updatev2d
 
-
    SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** ROUTINE updateSSH ***
       !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-      !!
+
       INTEGER :: ji, jj
-      !!---------------------------------------------
-      ! 
+
       IF (before) THEN
          DO jj=j1,j2
@@ -470,10 +413,11 @@
          END DO
       ELSE
+
 #if ! defined key_dynspg_ts
          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
             DO jj=j1,j2
                DO ji=i1,i2
-                  sshb(ji,jj) =   sshb(ji,jj) &
-                        & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
+                sshb(ji,jj) =   sshb(ji,jj) &
+                 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
                END DO
             END DO
@@ -486,5 +430,5 @@
          END DO
       ENDIF
-      !
+
    END SUBROUTINE updateSSH
 
@@ -493,12 +437,12 @@
       !!          *** ROUTINE updateub2b ***
       !!---------------------------------------------
+
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-      !!
+
       INTEGER :: ji, jj
       REAL(wp) :: zrhoy
-      !!---------------------------------------------
-      !
+
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -516,5 +460,5 @@
          END DO
       ENDIF
-      !
+
    END SUBROUTINE updateub2b
 
@@ -523,12 +467,12 @@
       !!          *** ROUTINE updatevb2b ***
       !!---------------------------------------------
+
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-      !!
+
       INTEGER :: ji, jj
       REAL(wp) :: zrhox
-      !!---------------------------------------------
-      !
+
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -546,112 +490,6 @@
          END DO
       ENDIF
-      !
+
    END SUBROUTINE updatevb2b
-
-
-   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
-      ! currently not used
-      !!---------------------------------------------
-      !!           *** ROUTINE updateT ***
-      !!---------------------------------------------
-#  include "domzgr_substitute.h90"
-
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL, iNTENT(in) :: before
-
-      INTEGER :: ji,jj,jk
-      REAL(wp) :: ztemp
-
-      IF (before) THEN
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
-                  tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk)
-                  tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()
-         tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox()
-         tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy()
-      ELSE
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN 
-                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
-                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk)
-                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk)
-                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))
-                     print *,'CORR = ',ztemp-1.
-                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, &
-                           tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp
-                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp
-                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp
-                  END IF
-               END DO
-            END DO
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE update_scales
-
-# if defined key_zdftke
-   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before )
-      !!---------------------------------------------
-      !!           *** ROUTINE updateen ***
-      !!---------------------------------------------
-      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      !!---------------------------------------------
-      !
-      IF (before) THEN
-         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2)
-      ELSE
-         en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
-      ENDIF
-      !
-   END SUBROUTINE updateEN
-
-
-   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before )
-      !!---------------------------------------------
-      !!           *** ROUTINE updateavt ***
-      !!---------------------------------------------
-      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      !!---------------------------------------------
-      !
-      IF (before) THEN
-         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)
-      ELSE
-         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
-      ENDIF
-      !
-   END SUBROUTINE updateAVT
-
-
-   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before )
-      !!---------------------------------------------
-      !!           *** ROUTINE updateavm ***
-      !!---------------------------------------------
-      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
-      LOGICAL, INTENT(in) :: before
-      !!---------------------------------------------
-      !
-      IF (before) THEN
-         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
-      ELSE
-         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
-      ENDIF
-      !
-   END SUBROUTINE updateAVM
-
-# endif /* key_zdftke */ 
 
 #else
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 10251)
@@ -7,5 +7,4 @@
    USE agrif_oce
    USE agrif_top_sponge
-   USE par_trc
    USE trc
    USE lib_mpp
@@ -15,10 +14,10 @@
    PRIVATE
 
-   PUBLIC Agrif_trc, interptrn
+   PUBLIC Agrif_trc
 
 #  include "domzgr_substitute.h90"  
 #  include "vectopt_loop_substitute.h90"
   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.6 , NEMO Consortium (2010)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -29,160 +28,114 @@
    SUBROUTINE Agrif_trc
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_trc  ***
+      !!                  ***  ROUTINE Agrif_Tra  ***
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3
+      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
       !!----------------------------------------------------------------------
       !
       IF( Agrif_Root() )   RETURN
 
+      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
+
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
+      ztra(:,:,:,:) = 0.e0
 
-      CALL Agrif_Bc_variable( trn_id, procname=interptrn )
+      CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn )
       Agrif_UseSpecialValue = .FALSE.
-      !
-   END SUBROUTINE Agrif_trc
 
-   SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
-      !!---------------------------------------------
-      !!   *** ROUTINE interptrn ***
-      !!---------------------------------------------
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      LOGICAL, INTENT(in) :: before
-      INTEGER, INTENT(in) :: nb , ndir
-      !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER :: imin, imax, jmin, jmax
-      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
-      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
-      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      zrhox = Agrif_Rhox()
 
-      IF (before) THEN         
-         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
-      ELSE
-         !
-         western_side  = (nb == 1).AND.(ndir == 1)
-         eastern_side  = (nb == 1).AND.(ndir == 2)
-         southern_side = (nb == 2).AND.(ndir == 1)
-         northern_side = (nb == 2).AND.(ndir == 2)
-         !
-         zrhox = Agrif_Rhox()
-         ! 
-         zalpha1 = ( zrhox - 1. ) * 0.5
-         zalpha2 = 1. - zalpha1
-         ! 
-         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha4 = 1. - zalpha3
-         ! 
-         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-         zalpha5 = 1. - zalpha6 - zalpha7
-         !
-         imin = i1
-         imax = i2
-         jmin = j1
-         jmax = j2
-         ! 
-         ! Remove CORNERS
-         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
-         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
-         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
-         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
-         !
-         IF( eastern_side) THEN
-            DO jn = 1, jptra
-               tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                     ELSE
-                        tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                           tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 
-                                 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
-                        ENDIF
+      alpha1 = ( zrhox - 1. ) * 0.5
+      alpha2 = 1. - alpha1
+
+      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+      alpha4 = 1. - alpha3
+
+      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+      alpha5 = 1. - alpha6 - alpha7
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+
+         DO jn = 1, jptra
+            tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                     tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                  ELSE
+                     tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                        tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn)  &
+                           &                 + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
                      ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         ! 
-         IF( northern_side ) THEN            
-            DO jn = 1, jptra
-               tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO ji = imin,imax
-                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                     ELSE
-                        tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                           tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  &
-                                 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
-               END DO
-            ENDDO
-         ENDIF
-         !
-         IF( western_side) THEN            
-            DO jn = 1, jptra
-               tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
-               DO jk = 1, jpkm1
-                  DO jj = jmin,jmax
-                     IF( umask(2,jj,jk) == 0.e0 ) THEN
-                        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
-                     ELSE
-                        tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
-                        IF( un(2,jj,jk) < 0.e0 ) THEN
-                           tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
-                        ENDIF
-                     ENDIF
-                  END DO
+                  ENDIF
                END DO
             END DO
-         ENDIF
-         !
-         IF( southern_side ) THEN           
-            DO jn = 1, jptra
-               tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
-               DO jk=1,jpk      
-                  DO ji=imin,imax
-                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
-                     ELSE
-                        tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
-                        IF( vn(ji,2,jk) < 0.e0 ) THEN
-                           tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
-                        ENDIF
+         ENDDO
+      ENDIF
+
+      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
+
+         DO jn = 1, jptra
+            tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn)
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                  ELSE
+                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)
+                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                        tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn)  &
+                           &                 + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
                      ENDIF
-                  END DO
+                  ENDIF
                END DO
-            ENDDO
-         ENDIF
-         !
-         ! Treatment of corners
-         ! 
-         ! East south
-         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
-         ENDIF
-         ! East north
-         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
-         ENDIF
-         ! West south
-         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
-            tra(2,2,:,:) = ptab(2,2,:,:)
-         ENDIF
-         ! West north
-         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
-            tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
-         ENDIF
-         !
+            END DO
+         ENDDO
+      ENDIF
+      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+         DO jn = 1, jptra
+            tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  IF( umask(2,jj,jk) == 0.e0 ) THEN
+                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
+                  ELSE
+                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)
+                     IF( un(2,jj,jk) < 0.e0 ) THEN
+                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
+         DO jn = 1, jptra
+            tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn)
+            DO jk=1,jpk
+               DO ji=1,jpi
+                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
+                  ELSE
+                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
+                     IF( vn(ji,2,jk) < 0.e0 ) THEN
+                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO
       ENDIF
       !
-   END SUBROUTINE interptrn
+      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
+      !
+
+   END SUBROUTINE Agrif_trc
 
 #else
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 10251)
@@ -1,8 +1,7 @@
 #define SPONGE_TOP
 
-MODULE agrif_top_sponge
+Module agrif_top_sponge
 #if defined key_agrif && defined key_top
    USE par_oce
-   USE par_trc
    USE oce
    USE dom_oce
@@ -17,31 +16,71 @@
    PRIVATE
 
-   PUBLIC Agrif_Sponge_trc, interptrn_sponge
+   PUBLIC Agrif_Sponge_Trc, interptrn
 
-   !! * Substitutions
+  !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.6 , NEMO Consortium (2010)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
-CONTAINS
+   CONTAINS
 
-   SUBROUTINE Agrif_Sponge_trc
+   SUBROUTINE Agrif_Sponge_Trc
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Sponge_Trc ***
       !!---------------------------------------------
       !! 
+      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
+      REAL(wp) :: ztra, zabe1, zabe2, zbtr
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff
 
 #if defined SPONGE_TOP
+      CALL wrk_alloc( jpi, jpj, ztru, ztrv )
+      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )
+
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
-      CALL Agrif_sponge
+
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      tabspongedone_trn = .FALSE.
-      CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge)
+      ztabr = 0.e0
+      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn)
       Agrif_UseSpecialValue = .FALSE.
+
+      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)
+
+      CALL Agrif_sponge
+
+      DO jn = 1, jptra
+         DO jk = 1, jpkm1
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
+                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+               ENDDO
+            ENDDO
+
+            DO jj = 2,jpjm1
+               DO ji = 2,jpim1
+                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+                  ! horizontal diffusive trends
+                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  )
+                  ! add it to the general tracer trends
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !
+         ENDDO
+      ENDDO
+ 
+      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
+      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
 
 #endif
@@ -49,57 +88,14 @@
    END SUBROUTINE Agrif_Sponge_Trc
 
-   SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
+   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
       !!---------------------------------------------
-      !!   *** ROUTINE interptrn_sponge ***
+      !!   *** ROUTINE interptn ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL, INTENT(in) :: before
+      !
+      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
 
-
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-
-      REAL(wp) :: ztra, zabe1, zabe2, zbtr
-      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff
-      !
-      IF (before) THEN
-         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
-      ELSE      
-
-         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)      
-         DO jn = 1, jptra
-            DO jk = 1, jpkm1
-
-               DO jj = j1,j2-1
-                  DO ji = i1,i2-1
-                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
-                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
-                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
-                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
-                  ENDDO
-               ENDDO
-
-               DO jj = j1+1,j2-1
-                  DO ji = i1+1,i2-1
-
-                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN 
-                        zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk)
-                        ! horizontal diffusive trends
-                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  )
-                        ! add it to the general tracer trends
-                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-                     ENDIF
-
-                  ENDDO
-               ENDDO
-
-            ENDDO
-         ENDDO
-
-         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
-      ENDIF
-      !                 
-   END SUBROUTINE interptrn_sponge
+   END SUBROUTINE interptrn
 
 #else
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 10251)
@@ -1,4 +1,3 @@
 #define TWO_WAY
-#undef DECAL_FEEDBACK
 
 MODULE agrif_top_update
@@ -9,5 +8,4 @@
    USE dom_oce
    USE agrif_oce
-   USE par_trc
    USE trc
    USE wrk_nemo  
@@ -26,5 +24,5 @@
    !!----------------------------------------------------------------------
 
-CONTAINS
+   CONTAINS
 
    SUBROUTINE Agrif_Update_Trc( kt )
@@ -32,65 +30,75 @@
       !!   *** ROUTINE Agrif_Update_Trc ***
       !!---------------------------------------------
+      !!
       INTEGER, INTENT(in) :: kt
-      !!---------------------------------------------
-      ! 
-      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
-#if defined TWO_WAY   
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
+
+  
+      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+
+#if defined TWO_WAY
+      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
+
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-      ! 
-      IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
-# if ! defined DECAL_FEEDBACK
-         CALL Agrif_Update_Variable(trn_id, procname=updateTRC)
-# else
-         CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC)
-# endif
+ 
+     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
+         CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC)
       ELSE
-# if ! defined DECAL_FEEDBACK
-         CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC)
-# else
-         CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC)
-# endif
+         CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC)
       ENDIF
-      !
+
       Agrif_UseSpecialValueInUpdate = .FALSE.
       nbcline_trc = nbcline_trc + 1
+
+      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
 #endif
-      !
+
    END SUBROUTINE Agrif_Update_Trc
 
-   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
+   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
       !!---------------------------------------------
-      !!           *** ROUTINE updateT ***
+      !!   *** ROUTINE UpdateTrc ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-      !!
+   
       INTEGER :: ji,jj,jk,jn
-      !!---------------------------------------------
-      !
-      IF (before) THEN
-         DO jn = n1,n2
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                     ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
-                  END DO
-               END DO
-            END DO
-         END DO
-      ELSE
-         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+
+         IF( before ) THEN
+            DO jn = n1, n2
+               DO jk = k1, k2
+                  DO jj = j1, j2
+                     DO ji = i1, i2
+                        tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                     ENDDO
+                  ENDDO
+               ENDDO
+            ENDDO
+         ELSE
+            IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
             ! Add asselin part
-            DO jn = n1,n2
-               DO jk=k1,k2
-                  DO jj=j1,j2
-                     DO ji=i1,i2
-                        IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN
-                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
-                                 & + atfp * ( ptab(ji,jj,jk,jn) &
-                                 &             - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+               DO jn = n1, n2
+                  DO jk = k1, k2
+                     DO jj = j1, j2
+                        DO ji = i1, i2
+                           IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
+                              trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
+                                 & + atfp * ( tabres(ji,jj,jk,jn) &
+                                               - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                           ENDIF
+                        ENDDO
+                     ENDDO
+                  ENDDO
+               ENDDO
+            ENDIF
+
+            DO jn = n1, n2
+               DO jk = k1, k2
+                  DO jj = j1, j2
+                     DO ji = i1, i2
+                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
+                           trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
@@ -99,17 +107,5 @@
             ENDDO
          ENDIF
-         DO jn = n1,n2
-            DO jk=k1,k2
-               DO jj=j1,j2
-                  DO ji=i1,i2
-                     IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 
-                        trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk)
-                     END IF
-                  END DO
-               END DO
-            END DO
-         END DO
-      ENDIF
-      ! 
+
    END SUBROUTINE updateTRC
 
@@ -123,3 +119,3 @@
    END SUBROUTINE agrif_top_update_empty
 #endif
-END MODULE agrif_top_update
+END Module agrif_top_update
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 10251)
@@ -17,4 +17,5 @@
    USE par_oce
    USE dom_oce
+   USE Agrif_Util
    USE nemogcm
    !
@@ -30,9 +31,5 @@
       jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
       jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
-! JC: change to allow for different vertical levels
-!     jpk is already set
-!     keep it jpk possibly different from jpkdta which 
-!     hold parent grid vertical levels number (set earlier)
-!      jpk     = jpkdta 
+      jpk     = jpkdta 
       jpim1   = jpi-1 
       jpjm1   = jpj-1 
@@ -67,7 +64,7 @@
    ! 0. Initializations
    !-------------------
-   IF( cp_cfg == 'orca' ) THEN
+   IF( cp_cfg == 'orca' ) then
       IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 &
-            &                      .OR. jp_cfg == 4 ) THEN
+  &                      .OR. jp_cfg == 4 ) THEN
          jp_cfg = -1    ! set special value for jp_cfg on fine grids
          cp_cfg = "default"
@@ -123,10 +120,10 @@
 SUBROUTINE agrif_declare_var_dom
    !!----------------------------------------------------------------------
-   !!                 *** ROUTINE agrif_declare_var ***
+   !!                 *** ROUTINE agrif_declarE_var ***
    !!
    !! ** Purpose :: Declaration of variables to be interpolated
    !!----------------------------------------------------------------------
    USE agrif_util
-   USE par_oce       
+   USE par_oce       !   ONLY : jpts
    USE oce
    IMPLICIT NONE
@@ -135,26 +132,23 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
+
 
    ! 2. Type of interpolation
    !-------------------------
-   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(e1u_id,(/0,0/))
-   CALL Agrif_Set_bc(e2v_id,(/0,0/))
+   Call Agrif_Set_bc(e1u_id,(/0,0/))
+   Call Agrif_Set_bc(e2v_id,(/0,0/))
 
    ! 5. Update type
    !--------------- 
-   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
-
-! High order updates
-!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
-!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
-    !
+   Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
+   Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
+
 END SUBROUTINE agrif_declare_var_dom
 
@@ -173,5 +167,4 @@
    USE nemogcm
    USE sol_oce
-   USE lib_mpp
    USE in_out_manager
    USE agrif_opa_update
@@ -181,7 +174,14 @@
    IMPLICIT NONE
    !
+   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp
+   REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp
+   REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d
    LOGICAL :: check_namelist
-   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
-   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+
+   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
+   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
+   ALLOCATE( tab2d(jpi, jpj)                )
+
 
    ! 1. Declaration of the type of variable which have to be interpolated
@@ -193,69 +193,44 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
-   CALL Agrif_Sponge
-   tabspongedone_tsn = .FALSE.
-   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
-   ! reset tsa to zero
-   tsa(:,:,:,:) = 0.
-
-   Agrif_UseSpecialValue = ln_spc_dyn
-   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
-   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
-   tabspongedone_u = .FALSE.
-   tabspongedone_v = .FALSE.
-   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
-   tabspongedone_u = .FALSE.
-   tabspongedone_v = .FALSE.
-   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
-
-#if defined key_dynspg_ts
-   Agrif_UseSpecialValue = .TRUE.
-   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
-
-   Agrif_UseSpecialValue = ln_spc_dyn
-   CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
-   CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
-   CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
-   CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
-   ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
-   ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
-   ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
-   ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
-#endif
-
-   Agrif_UseSpecialValue = .FALSE. 
-   ! reset velocities to zero
-   ua(:,:,:) = 0.
-   va(:,:,:) = 0.
+   Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn)
+   Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn)
+
+   Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu)
+   Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv)
+   Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun)
+   Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn)
+
+   Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb)
+   Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb)
+   Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn)
+   Agrif_UseSpecialValue = .FALSE.
 
    ! 3. Some controls
    !-----------------
-   check_namelist = .TRUE.
-
-   IF( check_namelist ) THEN 
+   check_namelist = .true.
+
+   IF( check_namelist ) THEN
 
       ! Check time steps           
-      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
-         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
-         WRITE(cl_check2,*)  NINT(rdt)
-         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
-         CALL ctl_warn( 'incompatible time step between grids',   &
-               &               'parent grid value : '//cl_check1    ,   & 
-               &               'child  grid value : '//cl_check2    ,   & 
-               &               'value on child grid will be changed to : '//cl_check3 )
-         rdt=Agrif_Parent(rdt)/Agrif_Rhot()
+      IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
+         WRITE(*,*) 'incompatible time step between grids'
+         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
+         WRITE(*,*) 'child  grid value : ',nint(rdt)
+         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
+         STOP
       ENDIF
 
       ! Check run length
       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
-         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
-         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
-         CALL ctl_warn( 'incompatible run length between grids'               ,   &
-               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
-               &              ' nitend on fine grid will be change to : '//cl_check2    )
-         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
-         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
+           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
+         WRITE(*,*) 'incompatible run length between grids'
+         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
+              Agrif_Parent(nit000)+1),' time step'
+         WRITE(*,*) 'child  grid value : ', &
+              (nitend-nit000+1),' time step'
+         WRITE(*,*) 'value on child grid should be : ', &
+              Agrif_IRhot() * (Agrif_Parent(nitend)- &
+              Agrif_Parent(nit000)+1)
+         STOP
       ENDIF
 
@@ -263,5 +238,5 @@
       IF( ln_zps ) THEN
          ! check parameters for partial steps 
-         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
+         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
             WRITE(*,*) 'incompatible e3zps_min between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
@@ -278,47 +253,14 @@
          ENDIF
       ENDIF
-      ! check if masks and bathymetries match
-      IF(ln_chk_bathy) THEN
-         !
-         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
-         !
-         kindic_agr = 0
-         ! check if umask agree with parent along western and eastern boundaries:
-         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
-         ! check if vmask agree with parent along northern and southern boundaries:
-         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
-	 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
-         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
-         !
-         IF (lk_mpp) CALL mpp_sum( kindic_agr )
-         IF( kindic_agr /= 0 ) THEN             		
-            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
-         ELSE
-            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
-         END IF
-      ENDIF
-      !
    ENDIF
-   ! 
-   ! Do update at initialisation because not done before writing restarts
-   ! This would indeed change boundary conditions values at initial time
-   ! hence produce restartability issues.
-   ! Note that update below is recursive (with lk_agrif_doupd=T):
-   ! 
-! JC: I am not sure if Agrif_MaxLevel() is the "relative"
-!     or the absolute maximum nesting level...TBC                        
-   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
-      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
-      CALL Agrif_Update_tra()
-      CALL Agrif_Update_dyn()
-   ENDIF
-   !
-# if defined key_zdftke
-!   CALL Agrif_Update_tke(0)
-# endif
-   !
-   Agrif_UseSpecialValueInUpdate = .FALSE.
+
+   CALL Agrif_Update_tra(0)
+   CALL Agrif_Update_dyn(0)
+
    nbcline = 0
-   lk_agrif_doupd = .FALSE.
+   !
+   DEALLOCATE(tabtstemp)
+   DEALLOCATE(tabuvtemp)
+   DEALLOCATE(tab2d)
    !
 END SUBROUTINE Agrif_InitValues_cont
@@ -334,5 +276,4 @@
    USE par_oce       !   ONLY : jpts
    USE oce
-   USE agrif_oce
    IMPLICIT NONE
    !!----------------------------------------------------------------------
@@ -340,120 +281,68 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
-
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
-
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
-
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
-
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
-
-   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
-
-# if defined key_zdftke
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
-   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
-# endif
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id)
+
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
+
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id)
+   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
+   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id)
 
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
-
-   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
+   CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear)
+
+   Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
 
    CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-
-   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
-   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
-   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
-
-# if defined key_zdftke
-   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
-# endif
-
+   Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(tsn_id,(/0,1/))
-   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
-   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
-
-!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
-!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
-!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
-   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
-   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
-   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
-
-   CALL Agrif_Set_bc(sshn_id,(/0,0/))
-   CALL Agrif_Set_bc(unb_id ,(/0,0/))
-   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
-   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
-   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
-
-   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
-   CALL Agrif_Set_bc(umsk_id,(/0,0/))
-   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
-
-# if defined key_zdftke
-   CALL Agrif_Set_bc(avm_id ,(/0,1/))
-# endif
+   Call Agrif_Set_bc(un_id,(/0,1/))
+   Call Agrif_Set_bc(vn_id,(/0,1/))
+
+   Call Agrif_Set_bc(sshn_id,(/0,1/))
+   Call Agrif_Set_bc(unb_id,(/0,1/))
+   Call Agrif_Set_bc(vnb_id,(/0,1/))
+   Call Agrif_Set_bc(ub2b_id,(/0,1/))
+   Call Agrif_Set_bc(vb2b_id,(/0,1/))
+
+   Call Agrif_Set_bc(tsn_id,(/0,1/))
+   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
+
+   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
+   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
 
    ! 5. Update type
    !--------------- 
-   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
-
-   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
-
-   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
-   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
-
-   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
-# if defined key_zdftke
-   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
-   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
-   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
-# endif
-
-! High order updates
-!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
-!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
-!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
-!
-!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
-!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
-!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
- 
-   !
+   Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
+   Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average)
+
+   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
+   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
+
+   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+   Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
 END SUBROUTINE agrif_declare_var
 # endif
@@ -476,5 +365,9 @@
    IMPLICIT NONE
    !
-   !!----------------------------------------------------------------------
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv
+   !!----------------------------------------------------------------------
+
+   ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7))
 
    ! 1. Declaration of the type of variable which have to be interpolated
@@ -508,4 +401,6 @@
    CALL Agrif_Update_lim2(0)
    !
+   DEALLOCATE( zvel, zadv )
+   !
 END SUBROUTINE Agrif_InitValues_cont_lim2
 
@@ -536,19 +431,19 @@
    !-------------------------
    CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
-   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
-   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
+   Call Agrif_Set_bc(adv_ice_id ,(/0,1/))
+   Call Agrif_Set_bc(u_ice_id,(/0,1/))
+   Call Agrif_Set_bc(v_ice_id,(/0,1/))
 
    ! 5. Update type
    !---------------
-   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
-   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-   ! 
+   Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
+   Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
 END SUBROUTINE agrif_declare_var_lim2
 #  endif
@@ -567,8 +462,6 @@
    USE nemogcm
    USE par_trc
-   USE lib_mpp
    USE trc
    USE in_out_manager
-   USE agrif_opa_sponge
    USE agrif_top_update
    USE agrif_top_interp
@@ -577,7 +470,9 @@
    IMPLICIT NONE
    !
-   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
+   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
    LOGICAL :: check_namelist
    !!----------------------------------------------------------------------
+
+   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
 
 
@@ -590,42 +485,35 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
+   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn)
+   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
    Agrif_UseSpecialValue = .FALSE.
-   CALL Agrif_Sponge
-   tabspongedone_trn = .FALSE.
-   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
-   ! reset tsa to zero
-   tra(:,:,:,:) = 0.
-
 
    ! 3. Some controls
    !-----------------
-   check_namelist = .TRUE.
+   check_namelist = .true.
 
    IF( check_namelist ) THEN
-# if defined key_offline
+#  if defined offline     
       ! Check time steps
-      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
-         WRITE(cl_check1,*)  Agrif_Parent(rdt)
-         WRITE(cl_check2,*)  rdt
-         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
-         CALL ctl_warn( 'incompatible time step between grids',   &
-               &               'parent grid value : '//cl_check1    ,   & 
-               &               'child  grid value : '//cl_check2    ,   & 
-               &               'value on child grid will be changed to  &
-               &               :'//cl_check3  )
-         rdt=rdt*Agrif_Rhot()
+      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
+         WRITE(*,*) 'incompatible time step between grids'
+         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
+         WRITE(*,*) 'child  grid value : ',nint(rdt)
+         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
+         STOP
       ENDIF
 
       ! Check run length
       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
-         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
-         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
-         CALL ctl_warn( 'incompatible run length between grids'               ,   &
-               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
-               &              ' nitend on fine grid will be change to : '//cl_check2    )
-         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
-         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
+           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
+         WRITE(*,*) 'incompatible run length between grids'
+         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
+              Agrif_Parent(nit000)+1),' time step'
+         WRITE(*,*) 'child  grid value : ', &
+              (nitend-nit000+1),' time step'
+         WRITE(*,*) 'value on child grid should be : ', &
+              Agrif_IRhot() * (Agrif_Parent(nitend)- &
+              Agrif_Parent(nit000)+1)
+         STOP
       ENDIF
 
@@ -633,5 +521,5 @@
       IF( ln_zps ) THEN
          ! check parameters for partial steps 
-         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
+         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
             WRITE(*,*) 'incompatible e3zps_min between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
@@ -640,5 +528,5 @@
             STOP
          ENDIF
-         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
+         IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
             WRITE(*,*) 'incompatible e3zps_rat between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
@@ -650,14 +538,14 @@
 #  endif         
       ! Check passive tracer cell
-      IF( nn_dttrc .NE. 1 ) THEN
+      IF( nn_dttrc .ne. 1 ) THEN
          WRITE(*,*) 'nn_dttrc should be equal to 1'
       ENDIF
    ENDIF
 
-   CALL Agrif_Update_trc(0)
-   !
-   Agrif_UseSpecialValueInUpdate = .FALSE.
+!ch   CALL Agrif_Update_trc(0)
    nbcline_trc = 0
    !
+   DEALLOCATE(tabtrtemp)
+   !
 END SUBROUTINE Agrif_InitValues_cont_top
 
@@ -670,5 +558,4 @@
    !!----------------------------------------------------------------------
    USE agrif_util
-   USE agrif_oce
    USE dom_oce
    USE trc
@@ -678,26 +565,24 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id)
 
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
+   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   CALL Agrif_Set_bc(trn_id,(/0,1/))
-!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
-   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   Call Agrif_Set_bc(trn_id,(/0,1/))
+   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
 
    ! 5. Update type
    !--------------- 
-   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
-
-!   Higher order update
-!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
-
-   !
+   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
+   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
+
+
 END SUBROUTINE agrif_declare_var_top
 # endif
@@ -707,4 +592,5 @@
    !!   *** ROUTINE Agrif_detect ***
    !!----------------------------------------------------------------------
+   USE Agrif_Types
    !
    INTEGER, DIMENSION(2) :: ksizex
@@ -728,16 +614,15 @@
    !
    INTEGER  ::   ios                 ! Local integer output status for namelist read
-   INTEGER  ::   iminspon
-   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
-   !!--------------------------------------------------------------------------------------
-   !
-   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
-   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
-
-   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
-   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
-902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
-   IF(lwm) WRITE ( numond, namagrif )
+   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
+   !!----------------------------------------------------------------------
+   !
+      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
+      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
+      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namagrif )
    !
    IF(lwp) THEN                    ! control print
@@ -750,5 +635,4 @@
       WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
       WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
-      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
       WRITE(numout,*) 
    ENDIF
@@ -759,10 +643,5 @@
    visc_dyn      = rn_sponge_dyn
    !
-   ! Check sponge length:
-   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
-   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
-   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
-   !
-   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
+   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
 # if defined key_lim2
    IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
@@ -785,45 +664,10 @@
    SELECT CASE( i )
    CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
-   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
-   CASE DEFAULT
-      indglob = indloc
+   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
+   CASE(3)   ;   indglob = indloc
+   CASE(4)   ;   indglob = indloc
    END SELECT
    !
 END SUBROUTINE Agrif_InvLoc
-
-SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
-   !!----------------------------------------------------------------------
-   !!                 *** ROUTINE Agrif_get_proc_info ***
-   !!----------------------------------------------------------------------
-   USE par_oce
-   IMPLICIT NONE
-   !
-   INTEGER, INTENT(out) :: imin, imax
-   INTEGER, INTENT(out) :: jmin, jmax
-   !!----------------------------------------------------------------------
-   !
-   imin = nimppt(Agrif_Procrank+1)  ! ?????
-   jmin = njmppt(Agrif_Procrank+1)  ! ?????
-   imax = imin + jpi - 1
-   jmax = jmin + jpj - 1
-   ! 
-END SUBROUTINE Agrif_get_proc_info
-
-SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
-   !!----------------------------------------------------------------------
-   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
-   !!----------------------------------------------------------------------
-   USE par_oce
-   IMPLICIT NONE
-   !
-   INTEGER,  INTENT(in)  :: imin, imax
-   INTEGER,  INTENT(in)  :: jmin, jmax
-   INTEGER,  INTENT(in)  :: nbprocs
-   REAL(wp), INTENT(out) :: grid_cost
-   !!----------------------------------------------------------------------
-   !
-   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
-   !
-END SUBROUTINE Agrif_estimate_parallel_cost
 
 # endif
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 10251)
@@ -431,13 +431,10 @@
          CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' )   ;   RETURN
       ENDIF
-      !                                         ! fill sf with slf_i and control print
-      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' )
       ! Open file for each variable to get his number of dimension
       DO ifpr = 1, jfld
-         CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday )
-         idv   = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar )        ! id of the variable sdjf%clvar
-         idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv)                 ! number of dimension for variable sdjf%clvar
-         IF( sf_dyn(ifpr)%num /= 0 )   CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open
-         ierr1=0
+         CALL iom_open( TRIM( cn_dir )//TRIM( slf_d(ifpr)%clname ), inum )
+         idv   = iom_varid( inum , slf_d(ifpr)%clvar )  ! id of the variable sdjf%clvar
+         idimv = iom_file ( inum )%ndims(idv)             ! number of dimension for variable sdjf%clvar
+         IF( inum /= 0 )   CALL iom_close( inum )       ! close file if already open
          IF( idimv == 3 ) THEN    ! 2D variable
                                       ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
@@ -451,4 +448,6 @@
          ENDIF
       END DO
+      !                                         ! fill sf with slf_i and control print
+      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' )
       !
       IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 10251)
@@ -50,19 +50,8 @@
    USE ice
 #endif
-   USE asminc, ONLY: ln_avgbkg
    IMPLICIT NONE
    PRIVATE
    
    PUBLIC   asm_bkg_wri   !: Write out the background state
-
-  !! * variables for calculating time means
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_tavg  , sn_tavg  
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_tavg  , vn_tavg
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_tavg
-#if defined key_zdfgls || key_zdftke
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_tavg
-#endif
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_tavg
-   REAL(wp),SAVE :: numtimes_tavg     ! No of times to average over
 
    !!----------------------------------------------------------------------
@@ -92,73 +81,9 @@
       INTEGER :: inum          ! File unit number
       REAL(wp) :: zdate        ! Date
-      INTEGER :: ierror
       !!-----------------------------------------------------------------------
 
-      ! If creating an averaged assim bkg, initialise on first timestep
-      IF ( ln_avgbkg .AND. kt == ( nn_it000 - 1) ) THEN
-         ! Allocate memory 
-         ALLOCATE( tn_tavg(jpi,jpj,jpk), STAT=ierror )
-         IF( ierror > 0 ) THEN
-            CALL ctl_stop( 'asm_wri_bkg: unable to allocate tn_tavg' )   ;   RETURN
-         ENDIF
-         tn_tavg(:,:,:)=0
-         ALLOCATE( sn_tavg(jpi,jpj,jpk), STAT=ierror )
-         IF( ierror > 0 ) THEN
-            CALL ctl_stop( 'asm_wri_bkg: unable to allocate sn_tavg' )   ;   RETURN
-         ENDIF
-         sn_tavg(:,:,:)=0
-         ALLOCATE( un_tavg(jpi,jpj,jpk), STAT=ierror )
-         IF( ierror > 0 ) THEN
-            CALL ctl_stop( 'asm_wri_bkg: unable to allocate un_tavg' )   ;   RETURN
-         ENDIF
-         un_tavg(:,:,:)=0
-         ALLOCATE( vn_tavg(jpi,jpj,jpk), STAT=ierror )
-         IF( ierror > 0 ) THEN
-            CALL ctl_stop( 'asm_wri_bkg: unable to allocate vn_tavg' )   ;   RETURN
-         ENDIF
-         vn_tavg(:,:,:)=0
-         ALLOCATE( sshn_tavg(jpi,jpj), STAT=ierror )
-         IF( ierror > 0 ) THEN
-            CALL ctl_stop( 'asm_wri_bkg: unable to allocate sshn_tavg' )   ;   RETURN
-         ENDIF
-         sshn_tavg(:,:)=0
-#if defined key_zdftke
-         ALLOCATE( en_tavg(jpi,jpj,jpk), STAT=ierror )
-         IF( ierror > 0 ) THEN
-            CALL ctl_stop( 'asm_wri_bkg: unable to allocate en_tavg' )   ;   RETURN
-         ENDIF
-         en_tavg(:,:,:)=0
-#endif
-         ALLOCATE( avt_tavg(jpi,jpj,jpk), STAT=ierror )
-         IF( ierror > 0 ) THEN
-            CALL ctl_stop( 'asm_wri_bkg: unable to allocate avt_tavg' )   ;   RETURN
-         ENDIF
-         avt_tavg(:,:,:)=0
-         
-         numtimes_tavg = REAL ( nitavgbkg_r -  nn_it000 + 1 )
-      ENDIF   
-
-      ! If creating an averaged assim bkg, sum the contribution every timestep
-      IF ( ln_avgbkg ) THEN 
-         IF (lwp) THEN
-              WRITE(numout,*) 'asm_wri_bkg : Summing assim bkg fields at timestep ',kt
-              WRITE(numout,*) '~~~~~~~~~~~~ '
-         ENDIF
-
-         tn_tavg(:,:,:)        = tn_tavg(:,:,:) + tsn(:,:,:,jp_tem) / numtimes_tavg
-         sn_tavg(:,:,:)        = sn_tavg(:,:,:) + tsn(:,:,:,jp_sal) / numtimes_tavg
-         sshn_tavg(:,:)        = sshn_tavg(:,:) + sshn (:,:) / numtimes_tavg
-         un_tavg(:,:,:)        = un_tavg(:,:,:) + un(:,:,:) / numtimes_tavg
-         vn_tavg(:,:,:)        = vn_tavg(:,:,:) + vn(:,:,:) / numtimes_tavg
-         avt_tavg(:,:,:)        = avt_tavg(:,:,:) + avt(:,:,:) / numtimes_tavg
-#if defined key_zdftke
-         en_tavg(:,:,:)       = en_tavg(:,:,:) + en(:,:,:) / numtimes_tavg
-#endif
-      ENDIF
-     
-
-      ! Write out background at time step nitbkg_r or nitavgbkg_r
-      IF ( ( .NOT. ln_avgbkg .AND. (kt == nitbkg_r) ) .OR. &
-      &          ( ln_avgbkg .AND. (kt == nitavgbkg_r) ) ) THEN
+      !                                !-------------------------------------------
+      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
+         !                             !-----------------------------------========
          !
          WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
@@ -172,56 +97,29 @@
             CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
             !
-            !
-            ! Write the information
-            IF ( ln_avgbkg ) THEN
-               IF( nitavgbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitavgbkg = 0
-                  zdate = REAL( ndastp )
+            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
+               zdate = REAL( ndastp )
 #if defined key_zdftke
-                  ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
-                  IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
-                  CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
+               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
 
 #endif
-               ELSE
-                  zdate = REAL( ndastp )
-               ENDIF
-               CALL iom_rstput( kt, nitavgbkg_r, inum, 'rdastp' , zdate   )
-               CALL iom_rstput( kt, nitavgbkg_r, inum, 'un'     , un_tavg )
-               CALL iom_rstput( kt, nitavgbkg_r, inum, 'vn'     , vn_tavg )
-               CALL iom_rstput( kt, nitavgbkg_r, inum, 'tn'     , tn_tavg )
-               CALL iom_rstput( kt, nitavgbkg_r, inum, 'sn'     , sn_tavg )
-               CALL iom_rstput( kt, nitavgbkg_r, inum, 'sshn'   , sshn_tavg)
+            ELSE
+               zdate = REAL( ndastp )
+            ENDIF
+            !
+            !                                      ! Write the information
+            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
 #if defined key_zdftke
-               CALL iom_rstput( kt, nitavgbkg_r, inum, 'en'     , en_tavg )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
 #endif
-               CALL iom_rstput( kt, nitavgbkg_r, inum, 'avt'    , avt_tavg)
-               !
-            ELSE
-               IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
-                  zdate = REAL( ndastp )
-#if defined key_zdftke
-                  ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
-                  IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
-                  CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
-
-#endif
-               ELSE
-                  zdate = REAL( ndastp )
-               ENDIF
-               CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   )
-               CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
-               CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
-               CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
-               CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
-               CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              )
-#if defined key_zdftke
-               CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
-#endif
-               CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt               )
-               !
-            ENDIF
-            
+            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
+            !
             CALL iom_close( inum )
-
          ENDIF
          !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 10251)
@@ -40,16 +40,4 @@
 #endif
    USE sbc_oce          ! Surface boundary condition variables.
-   USE zdfmxl, ONLY :  &  
-   &  hmld_tref,       &   
-#if defined key_karaml
-   &  hmld_kara,       &
-   &  ln_kara,         &
-#endif   
-   &  hmld,            & 
-   &  hmlp,            &
-   &  hmlpt
-#if defined key_bdy 
-   USE bdy_oce, ONLY: bdytmask  
-#endif  
 
    IMPLICIT NONE
@@ -69,5 +57,4 @@
 #endif
    LOGICAL, PUBLIC :: ln_bkgwri = .FALSE.      !: No output of the background state fields
-   LOGICAL, PUBLIC :: ln_avgbkg = .FALSE.      !: No output of the mean background state fields
    LOGICAL, PUBLIC :: ln_asmiau = .FALSE.      !: No applying forcing with an assimilation increment
    LOGICAL, PUBLIC :: ln_asmdin = .FALSE.      !: No direct initialization
@@ -91,5 +78,4 @@
    INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval 
    INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval
-   INTEGER , PUBLIC ::   nitavgbkg   !: Number of timesteps to average assim bkg [0,nitavgbkg]
    ! 
    INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting
@@ -99,11 +85,4 @@
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   seaice_bkginc         ! Increment to the background sea ice conc
-
-   INTEGER :: mld_choice        = 4   !: choice of mld criteria to use for physics assimilation
-                                      !: 1) hmld      - Turbocline/mixing depth                           [W points]
-                                      !: 2) hmlp      - Density criterion (0.01 kg/m^3 change from 10m)   [W points]
-                                      !: 3) hmld_kara - Kara MLD                                          [Interpolated]
-                                      !: 4) hmld_tref - Temperature criterion (0.2 K change from surface) [T points]
-
 
    !! * Substitutions
@@ -138,6 +117,4 @@
       INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step
       INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step
-      INTEGER :: isurfstat       ! Local integer for status of reading surft variable
-      INTEGER :: iitavgbkg_date  ! Date YYYYMMDD of end of assim bkg averaging period
       !
       REAL(wp) :: znorm        ! Normalization factor for IAU weights
@@ -148,20 +125,11 @@
       REAL(wp) :: zdate_inc    ! Time axis in increments file
       !
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: & 
-          &       t_bkginc_2d  ! file for reading in 2D  
-      !                        ! temperature increments 
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: & 
-          &       z_mld     ! Mixed layer depth 
-          
       REAL(wp), POINTER, DIMENSION(:,:) ::   hdiv   ! 2D workspace
-      !
-      LOGICAL :: lk_surft      ! Logical: T => Increments file contains surft variable 
-                               !               so only apply surft increments.
-      !!
-      NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg,                           &
+      !!
+      NAMELIST/nam_asminc/ ln_bkgwri,                                      &
          &                 ln_trainc, ln_dyninc, ln_sshinc,                &
          &                 ln_asmdin, ln_asmiau,                           &
          &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   &
-         &                 ln_salfix, salfixmin, nn_divdmp, nitavgbkg, mld_choice
+         &                 ln_salfix, salfixmin, nn_divdmp
       !!----------------------------------------------------------------------
 
@@ -169,23 +137,6 @@
       ! Read Namelist nam_asminc : assimilation increment interface
       !-----------------------------------------------------------------------
-
-      ! Set default values
-      ln_bkgwri = .FALSE.
-      ln_avgbkg = .FALSE.
-      ln_trainc = .FALSE.
-      ln_dyninc = .FALSE.
-      ln_sshinc = .FALSE.
       ln_seaiceinc = .FALSE.
-      ln_asmdin = .FALSE.
-      ln_asmiau = .TRUE.
-      ln_salfix = .FALSE.
       ln_temnofreeze = .FALSE.
-      salfixmin = -9999
-      nitbkg    = 0
-      nitdin    = 0      
-      nitiaustr = 1
-      nitiaufin = 150
-      niaufn    = 0
-      nitavgbkg = 1
 
       REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment
@@ -205,5 +156,4 @@
          WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters'
          WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri
-         WRITE(numout,*) '      Logical switch for writing mean background state         ln_avgbkg = ', ln_avgbkg
          WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc
          WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc
@@ -216,9 +166,7 @@
          WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr
          WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin
-         WRITE(numout,*) '      Number of timesteps to average assim bkg [0,nitavgbkg]   nitavgbkg = ', nitavgbkg
          WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn
          WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix
          WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin
-         WRITE(numout,*) '      Choice of MLD for physics assimilation                  mld_choice = ', mld_choice
       ENDIF
 
@@ -227,5 +175,4 @@
       nitiaustr_r = nitiaustr + nit000 - 1  ! Start of IAU interval referenced to nit000
       nitiaufin_r = nitiaufin + nit000 - 1  ! End of IAU interval referenced to nit000
-      nitavgbkg_r = nitavgbkg + nit000 - 1  ! Averaging period referenced to nit000
 
       iiauper = nitiaufin_r - nitiaustr_r + 1  ! IAU interval length
@@ -237,5 +184,4 @@
       CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0
       CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )     ! IAU end time referenced to ndate0
-      CALL calc_date( nit000, nitavgbkg_r, ndate0, iitavgbkg_date )     ! End of assim bkg averaging period referenced to ndate0
       !
       IF(lwp) THEN
@@ -249,5 +195,4 @@
          WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r
          WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r
-         WRITE(numout,*) '       nitavgbkg_r = ', nitavgbkg_r
          WRITE(numout,*)
          WRITE(numout,*) '   Dates referenced to current cycle:'
@@ -259,5 +204,4 @@
          WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date
          WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date
-         WRITE(numout,*) '       iitavgbkg_date = ', iitavgbkg_date
       ENDIF
 
@@ -302,9 +246,4 @@
          & CALL ctl_stop( ' nitdin :',  &
          &                ' Background time step for Direct Initialization is outside', &
-         &                ' the cycle interval')
-
-      IF ( nitavgbkg_r > nitend ) &
-         & CALL ctl_stop( ' nitavgbkg_r :',  &
-         &                ' Assim bkg averaging period is outside', &
          &                ' the cycle interval')
 
@@ -386,26 +325,20 @@
       !--------------------------------------------------------------------
 
-      IF ( ln_trainc ) THEN
-         ALLOCATE( t_bkginc(jpi,jpj,jpk) )
-         ALLOCATE( s_bkginc(jpi,jpj,jpk) )
-         t_bkginc(:,:,:) = 0.0
-         s_bkginc(:,:,:) = 0.0
-      ENDIF
-      IF ( ln_dyninc ) THEN 
-         ALLOCATE( u_bkginc(jpi,jpj,jpk) )
-         ALLOCATE( v_bkginc(jpi,jpj,jpk) )
-         u_bkginc(:,:,:) = 0.0
-         v_bkginc(:,:,:) = 0.0
-      ENDIF
-      IF ( ln_sshinc ) THEN
-         ALLOCATE( ssh_bkginc(jpi,jpj)   )
-         ssh_bkginc(:,:) = 0.0
-      ENDIF
-      IF ( ln_seaiceinc ) THEN 
-         ALLOCATE( seaice_bkginc(jpi,jpj))
-         seaice_bkginc(:,:) = 0.0
-      ENDIF
+      ALLOCATE( t_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( s_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( u_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( v_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( ssh_bkginc(jpi,jpj)   )
+      ALLOCATE( seaice_bkginc(jpi,jpj))
 #if defined key_asminc
       ALLOCATE( ssh_iau(jpi,jpj)      )
+#endif
+      t_bkginc(:,:,:) = 0.0
+      s_bkginc(:,:,:) = 0.0
+      u_bkginc(:,:,:) = 0.0
+      v_bkginc(:,:,:) = 0.0
+      ssh_bkginc(:,:) = 0.0
+      seaice_bkginc(:,:) = 0.0
+#if defined key_asminc
       ssh_iau(:,:)    = 0.0
 #endif
@@ -443,72 +376,13 @@
 
          IF ( ln_trainc ) THEN   
-
-            !Test if the increments file contains the surft variable.
-            isurfstat = iom_varid( inum, 'bckinsurft', ldstop = .FALSE. )
-            IF ( isurfstat == -1 ) THEN
-               lk_surft = .FALSE.
-            ELSE
-               lk_surft = .TRUE.
-               CALL ctl_warn( ' Applying 2D temperature increment to bottom of ML: ', &
-            &                 ' bckinsurft found in increments file.' )
-            ENDIF             
-
-            IF (lk_surft) THEN 
-                
-               ALLOCATE(z_mld(jpi,jpj)) 
-               SELECT CASE(mld_choice) 
-               CASE(1) 
-                  z_mld = hmld 
-               CASE(2) 
-                  z_mld = hmlp 
-               CASE(3) 
-#if defined key_karaml
-                  IF ( ln_kara ) THEN
-                     z_mld = hmld_kara
-                  ELSE
-                     CALL ctl_stop("Kara mixed layer not calculated as ln_kara=.false.")
-                  ENDIF
-#else
-                  CALL ctl_stop("Kara mixed layer not defined in current version of NEMO")  ! JW: Safety feature, should be removed
-                                                                                            ! once the Kara mixed layer is available 
-#endif
-               CASE(4) 
-                  z_mld = hmld_tref 
-               END SELECT       
-                      
-               ALLOCATE( t_bkginc_2d(jpi,jpj) ) 
-               CALL iom_get( inum, jpdom_autoglo, 'bckinsurft', t_bkginc_2d, 1) 
-#if defined key_bdy                
-               DO jk = 1,jpkm1 
-                  WHERE( z_mld(:,:) > fsdepw(:,:,jk) ) 
-                     t_bkginc(:,:,jk) = t_bkginc_2d(:,:) * 0.5 * &
-                     &       ( 1 + cos( (fsdept(:,:,jk)/z_mld(:,:) ) * rpi ) )
-                     
-                     t_bkginc(:,:,jk) = t_bkginc(:,:,jk) * bdytmask(:,:) 
-                  ELSEWHERE 
-                     t_bkginc(:,:,jk) = 0. 
-                  ENDWHERE 
-               ENDDO 
-#else 
-               t_bkginc(:,:,:) = 0. 
-#endif                
-               s_bkginc(:,:,:) = 0. 
-                
-               DEALLOCATE(z_mld, t_bkginc_2d) 
-            
-            ELSE 
-               
-               CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 )
-               CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 )
-               ! Apply the masks
-               t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:)
-               s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:)
-               ! Set missing increments to 0.0 rather than 1e+20
-               ! to allow for differences in masks
-               WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0
-               WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0
-         
-            ENDIF
-
+            CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 )
+            CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 )
+            ! Apply the masks
+            t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:)
+            s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0
+            WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0
          ENDIF
 
@@ -782,5 +656,5 @@
 
       DO jk = 1, jpkm1
-        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) )
+         fzptnz(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) )
       END DO
 
@@ -1016,8 +890,4 @@
             ENDIF
 
-#if defined key_asminc
-         ELSE
-            ssh_iau(:,:) = 0._wp
-#endif
          ENDIF
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 10251)
@@ -29,5 +29,4 @@
    INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000
    INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR
-   INTEGER, PUBLIC :: nitavgbkg_r   !: Averaging period for assim bkg referenced to nit000
 
    !!----------------------------------------------------------------------
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 10251)
@@ -71,11 +71,4 @@
       REAL, POINTER, DIMENSION(:,:)   ::  ht_s  !: now snow thickness
 #endif
-#if defined key_top
-      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply
-      REAL(wp)                            :: rn_fac  !: multiplicative scaling factor
-      REAL(wp), POINTER, DIMENSION(:,:)   :: trc     !: now field of the tracer
-      LOGICAL                             :: dmp     !: obc damping term
-#endif
-
    END TYPE OBC_DATA
 
@@ -108,9 +101,4 @@
    LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping
    LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping
-   
-!   !JT
-   LOGICAL, DIMENSION(jp_bdy) ::   ln_ssh_bdy               !: =T USE SSH BDY - name list switch
-!   !JT
-   
    REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp              !: Damping time scale in days
    REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 10251)
@@ -37,8 +37,4 @@
 #endif
    USE sbcapr
-#if defined key_top
-   USE par_trc
-   USE trc, ONLY: trn
-#endif
 
    IMPLICIT NONE
@@ -398,22 +394,4 @@
 #endif
       ! end jchanut tschanges
-      
-      
-      !JT use sshn (ssh now) if ln_ssh_bdy set to false in the name list
-      DO ib_bdy = 1, nb_bdy   
-        nblen => idx_bdy(ib_bdy)%nblen
-        dta => dta_bdy(ib_bdy)
-         
-        ilen1(:) = nblen(:)
-        !JT IF( .NOT. dta%ll_ssh ) THEN 
-        IF( .NOT. ln_ssh_bdy(ib_bdy) ) THEN 
-          igrd = 1 ! t Grid
-          DO ib = 1, ilen1(igrd)
-              ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
-              ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-              dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)         
-          END DO 
-        END IF
-      END DO 
 
       IF ( ln_apr_obc ) THEN
@@ -452,5 +430,4 @@
       CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files
       CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files
-      CHARACTER(len = 256)::   clname                           ! temporary file name
       LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data
                                                                 ! =F => baroclinic velocities in 3D boundary data
@@ -692,20 +669,12 @@
             ! sea ice
             IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN
-               ! Test for types of ice input (lim2 or lim3)
-               ! Build file name to find dimensions 
-               clname=TRIM(bn_a_i%clname)
-               IF( .NOT. bn_a_i%ln_clim ) THEN   
-                                                  WRITE(clname, '(a,"_y",i4.4)' ) TRIM( bn_a_i%clname ), nyear    ! add year
-                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname        ), nmonth   ! add month
-               ELSE
-                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( bn_a_i%clname ), nmonth   ! add month
-               ENDIF
-               IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) &
-               &                                  WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname        ), nday     ! add day
-               !
-               CALL iom_open  ( clname, inum )
-               id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. )
+
+               ! Test for types of ice input (lim2 or lim3) 
+               CALL iom_open ( bn_a_i%clname, inum )
+               id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. )
                CALL iom_close ( inum )
-
+               !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. )
+               !CALL iom_open ( bn_a_i%clname, inum )
+               !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. )
       	       IF ( zndims == 4 ) THEN
                  ll_bdylim3 = .TRUE.   ! lim3 input
@@ -804,20 +773,10 @@
             IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) )
          ENDIF
-         IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN         
-            !JT 
-            !JT allocate ssh if dta%ll_ssh set too false, as may still use it
-            IF (dta%ll_ssh) THEN
-                IF( dta%ll_ssh ) THEN
-                  if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
-                  jfld = jfld + 1
-                  dta%ssh => bf(jfld)%fnow(:,1,1)
-                ENDIF
-            ELSE
-              if(lwp) write(numout,*) '++++++ dta%ssh allocated space'
-              !ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) )            
-              ALLOCATE( dta%ssh(nblen(1)) )            
-            ENDIF
-            !JT if 
-            
+         IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN
+            IF( dta%ll_ssh ) THEN
+               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
+               jfld = jfld + 1
+               dta%ssh => bf(jfld)%fnow(:,1,1)
+            ENDIF
             IF ( dta%ll_u2d ) THEN
                IF ( ln_full_vel_array(ib_bdy) ) THEN
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 10251)
@@ -49,8 +49,8 @@
       !!----------------------------------------------------------------------
       INTEGER,                      INTENT(in) ::   kt   ! Main time step counter
-      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d 
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pub2d, pvb2d
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: phur, phvr
-      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pssh
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pub2d, pvb2d
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phur, phvr
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pssh
       !!
       INTEGER                                  ::   ib_bdy ! Loop counter
@@ -92,5 +92,5 @@
       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
-      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
       !!
       INTEGER  ::   jb, jk         ! dummy loop indices
@@ -147,6 +147,6 @@
       TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
       INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index
-      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pua2d, pva2d
-      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pssh, phur, phvr 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr 
 
       INTEGER  ::   jb, igrd                         ! dummy loop indices
@@ -237,6 +237,6 @@
       TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
       INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set
-      REAL(wp), DIMENSION(:,:),     INTENT(inout) :: pua2d, pva2d
-      REAL(wp), DIMENSION(:,:),     INTENT(in) :: pub2d, pvb2d 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d 
       LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version
 
@@ -271,8 +271,8 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zssh ! Sea level
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zssh ! Sea level
       !!
       INTEGER  ::   ib_bdy, ib, igrd                        ! local integers
-      INTEGER  ::   ii, ij, zcoef, ip, jp   !   "       "
+      INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   !   "       "
 
       igrd = 1                       ! Everything is at T-points here
@@ -283,7 +283,19 @@
             ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
             ! Set gradient direction:
-            zcoef = bdytmask(ii-1,ij) + bdytmask(ii+1,ij) +  bdytmask(ii,ij-1) +  bdytmask(ii,ij+1)
-            IF ( zcoef == 0 ) THEN
-               zssh(ii,ij) = 0._wp
+            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
+            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
+            IF ( zcoef1+zcoef2 == 0 ) THEN
+               ! corner
+!               zcoef = tmask(ii-1,ij,1) + tmask(ii+1,ij,1) +  tmask(ii,ij-1,1) +  tmask(ii,ij+1,1)
+!               zssh(ii,ij) = zssh(ii-1,ij  ) * tmask(ii-1,ij  ,1) + &
+!                 &           zssh(ii+1,ij  ) * tmask(ii+1,ij  ,1) + &
+!                 &           zssh(ii  ,ij-1) * tmask(ii  ,ij-1,1) + &
+!                 &           zssh(ii  ,ij+1) * tmask(ii  ,ij+1,1)
+               zcoef = bdytmask(ii-1,ij) + bdytmask(ii+1,ij) +  bdytmask(ii,ij-1) +  bdytmask(ii,ij+1)
+               zssh(ii,ij) = zssh(ii-1,ij  ) * bdytmask(ii-1,ij  ) + &
+                 &           zssh(ii+1,ij  ) * bdytmask(ii+1,ij  ) + &
+                 &           zssh(ii  ,ij-1) * bdytmask(ii  ,ij-1) + &
+                 &           zssh(ii  ,ij+1) * bdytmask(ii  ,ij+1)
+               zssh(ii,ij) = ( zssh(ii,ij) / MAX( 1, zcoef) ) * tmask(ii,ij,1)
             ELSE
                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 10251)
@@ -61,8 +61,4 @@
          CASE('zero')
             CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
-         CASE('zerograd') 
-            CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )       
-         CASE('neumann') 
-            CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy )
          CASE('orlanski')
             CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. )
@@ -121,54 +117,4 @@
 
    END SUBROUTINE bdy_dyn3d_spe
-
-   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 
-      !!---------------------------------------------------------------------- 
-      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  *** 
-      !! 
-      !! ** Purpose : - Enforce a zero gradient of normal velocity 
-      !! 
-      !!---------------------------------------------------------------------- 
-      INTEGER                     ::   kt 
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
-      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
-      !! 
-      INTEGER  ::   jb, jk         ! dummy loop indices 
-      INTEGER  ::   ii, ij, igrd   ! local integers 
-      REAL(wp) ::   zwgt           ! boundary weight 
-      INTEGER  ::   fu, fv 
-      !!---------------------------------------------------------------------- 
-      ! 
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zgrad') 
-      ! 
-      igrd = 2                      ! Copying tangential velocity into bdy points 
-      DO jb = 1, idx%nblenrim(igrd) 
-         DO jk = 1, jpkm1 
-            ii   = idx%nbi(jb,igrd) 
-            ij   = idx%nbj(jb,igrd) 
-            fu   = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 
-            ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 
-                        &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 
-         END DO 
-      END DO 
-      ! 
-      igrd = 3                      ! Copying tangential velocity into bdy points 
-      DO jb = 1, idx%nblenrim(igrd) 
-         DO jk = 1, jpkm1 
-            ii   = idx%nbi(jb,igrd) 
-            ij   = idx%nbj(jb,igrd) 
-            fv   = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 
-            va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 
-                        &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 
-         END DO 
-      END DO 
-      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
-      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
-      ! 
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
- 
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zgrad') 
- 
-   END SUBROUTINE bdy_dyn3d_zgrad 
 
    SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )
@@ -357,39 +303,4 @@
    END SUBROUTINE bdy_dyn3d_dmp
 
-   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy ) 
-      !!---------------------------------------------------------------------- 
-      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  *** 
-      !!              
-      !!              - Apply Neumann condition to baroclinic velocities.  
-      !!              - Wrapper routine for bdy_nmn 
-      !!  
-      !! 
-      !!---------------------------------------------------------------------- 
-      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
-      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
- 
-      INTEGER  ::   jb, igrd                               ! dummy loop indices 
-      !!---------------------------------------------------------------------- 
- 
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_nmn') 
-      ! 
-      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.  
-      ! 
-      igrd = 2      ! Neumann bc on u-velocity;  
-      !             
-      CALL bdy_nmn( idx, igrd, ua ) 
- 
-      igrd = 3      ! Neumann bc on v-velocity 
-      !   
-      CALL bdy_nmn( idx, igrd, va ) 
-      ! 
-      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
-      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 
-      ! 
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_nmn') 
-      ! 
-   END SUBROUTINE bdy_dyn3d_nmn 
- 
-
 #else
    !!----------------------------------------------------------------------
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 10251)
@@ -107,8 +107,4 @@
       REAL(wp) ::   zwgt, zwgt1        ! local scalar
       REAL(wp) ::   ztmelts, zdh
-#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif
-     USE ice_2, vt_s => hsnm
-     USE ice_2, vt_i => hicm
-#endif
 
       !!------------------------------------------------------------------------------
@@ -119,5 +115,5 @@
       !
 #if defined key_lim2
-      DO jb = 1, idx%nblenrim(jgrd)
+      DO jb = 1, idx%nblen(jgrd)
          ji    = idx%nbi(jb,jgrd)
          jj    = idx%nbj(jb,jgrd)
@@ -139,5 +135,5 @@
 
       DO jl = 1, jpl
-         DO jb = 1, idx%nblenrim(jgrd)
+         DO jb = 1, idx%nblen(jgrd)
             ji    = idx%nbi(jb,jgrd)
             jj    = idx%nbj(jb,jgrd)
@@ -175,5 +171,5 @@
 
       DO jl = 1, jpl
-         DO jb = 1, idx%nblenrim(jgrd)
+         DO jb = 1, idx%nblen(jgrd)
             ji    = idx%nbi(jb,jgrd)
             jj    = idx%nbj(jb,jgrd)
@@ -328,5 +324,5 @@
                
                jgrd = 2      ! u velocity
-               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
+               DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd)
                   ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
@@ -357,5 +353,5 @@
                
                jgrd = 3      ! v velocity
-               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
+               DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd)
                   ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 10251)
@@ -76,5 +76,5 @@
       INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices
       INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers
-      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy         !   -       -
+      INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       -
       INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
       INTEGER  ::   jpbdtau, jpbdtas                       !   -       -
@@ -105,9 +105,4 @@
       !!
       NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend
-      
-      
-!      ! JT
-      NAMELIST/nambdy_ssh/ ln_ssh_bdy
-!      ! JT
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       !!----------------------------------------------------------------------
@@ -137,24 +132,4 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nambdy )
-      !JT Read nambdy_ssh namelist 
-      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries  
-      READ  ( numnam_ref, nambdy_ssh, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_ssh in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
-      READ  ( numnam_cfg, nambdy_ssh, IOSTAT = ios, ERR = 906)
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_ssh in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, nambdy_ssh )
-      
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'nambdy_ssh : use of ssh boundaries'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~'
-      IF(lwp) WRITE(numout,*) '      ln_ssh_bdy: '
-      DO ib_bdy = 1,nb_bdy
-        IF(lwp) WRITE(numout,*) '      ln_ssh_bdy(',ib_bdy,'): ',ln_ssh_bdy(ib_bdy)
-      ENDDO
-      IF(lwp) WRITE(numout,*) '~~~~~~~~'
-      IF(lwp) WRITE(numout,*) 
-      !JT
 
       ! -----------------------------------------
@@ -210,20 +185,4 @@
           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' )
         END SELECT
-        
-        !JT override dta_bdy(ib_bdy)%ll_ssh with namelist value (ln_ssh_bdy)
-        IF(lwp) WRITE(numout,*) 'nambdy_ssh : use of ssh boundaries'
-        IF(lwp) WRITE(numout,*) '~~~~~~~~'
-        IF(lwp) WRITE(numout,*) '      ib_bdy: ',ib_bdy
-        IF(lwp) WRITE(numout,*) '      Prior to Implementation of nambdy_ssh'
-        IF(lwp) WRITE(numout,*) '      dta_bdy(ib_bdy)%ll_ssh: ',dta_bdy(ib_bdy)%ll_ssh
-        
-        dta_bdy(ib_bdy)%ll_ssh = ln_ssh_bdy(ib_bdy)
-        
-        IF(lwp) WRITE(numout,*) '      After to Implementation of nambdy_ssh'
-        IF(lwp) WRITE(numout,*) '      dta_bdy(ib_bdy)%ll_ssh: ',dta_bdy(ib_bdy)%ll_ssh
-        IF(lwp) WRITE(numout,*) '~~~~~~~~'
-        
-        !JT         
-        
         IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN
            SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   ! 
@@ -254,12 +213,4 @@
              dta_bdy(ib_bdy)%ll_u3d = .true.
              dta_bdy(ib_bdy)%ll_v3d = .true.
-          CASE('neumann') 
-             IF(lwp) WRITE(numout,*) '      Neumann conditions' 
-             dta_bdy(ib_bdy)%ll_u3d = .false. 
-             dta_bdy(ib_bdy)%ll_v3d = .false. 
-          CASE('zerograd') 
-             IF(lwp) WRITE(numout,*) '      Zero gradient for baroclinic velocities' 
-             dta_bdy(ib_bdy)%ll_u3d = .false. 
-             dta_bdy(ib_bdy)%ll_v3d = .false.
           CASE('zero')
              IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)'
@@ -826,8 +777,8 @@
 !      is = mjg(1) + 1            ! if monotasking and no zoom, is=2
 !      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1      
-      iwe = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2
-      ies = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1
-      iso = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2
-      ino = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1
+      iw = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2
+      ie = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1
+      is = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2
+      in = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1
 
       ALLOCATE( nbondi_bdy(nb_bdy))
@@ -902,6 +853,6 @@
                ENDIF
                ! check if point is in local domain
-               IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
-                  & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino      ) THEN
+               IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   &
+                  & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) THEN
                   !
                   icount = icount  + 1
@@ -939,5 +890,4 @@
          com_south_b = 0
          com_north_b = 0
-
          DO igrd = 1, jpbgrd
             icount  = 0
@@ -946,6 +896,6 @@
                DO ib = 1, nblendta(igrd,ib_bdy)
                   ! check if point is in local domain and equals ir
-                  IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
-                     & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND.   &
+                  IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   &
+                     & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   &
                      & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                      !
@@ -1136,7 +1086,5 @@
             DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
                nbr => idx_bdy(ib_bdy)%nbr(ib,igrd)
-               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) * 0.5 &
-                                            &  *(10./ FLOAT(nn_rimwidth(ib_bdy))) ) ! JGraham:modified for rim=15
-!               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation
+               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation
 !               idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.  ! quadratic
 !               idx_bdy(ib_bdy)%nbw(ib,igrd) =  FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy))       ! linear
@@ -1646,5 +1594,5 @@
             ELSE
                ! This is a corner
-               IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
+               WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
                CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1))
                itest=itest+1
@@ -1660,5 +1608,5 @@
             ELSE
                ! This is a corner
-               IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
+               WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
                CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2))
                itest=itest+1
@@ -1690,5 +1638,5 @@
             ELSE
                ! This is a corner
-               IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
+               WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
                CALL bdy_ctl_corn(npckge(ib), icorne(ib,1))
                itest=itest+1
@@ -1704,5 +1652,5 @@
             ELSE
                ! This is a corner
-               IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
+               WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
                CALL bdy_ctl_corn(npckge(ib), icorne(ib,2))
                itest=itest+1
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 10251)
@@ -26,5 +26,4 @@
    PUBLIC   bdy_orlanski_2d     ! routine called where?
    PUBLIC   bdy_orlanski_3d     ! routine called where?
-   PUBLIC   bdy_nmn     ! routine called where? 
 
    !!----------------------------------------------------------------------
@@ -355,77 +354,4 @@
    END SUBROUTINE bdy_orlanski_3d
 
-   SUBROUTINE bdy_nmn( idx, igrd, phia ) 
-      !!---------------------------------------------------------------------- 
-      !!                 ***  SUBROUTINE bdy_nmn  *** 
-      !!                     
-      !! ** Purpose : Duplicate the value at open boundaries, zero gradient. 
-      !!  
-      !!---------------------------------------------------------------------- 
-      INTEGER,                    INTENT(in)     ::   igrd     ! grid index 
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated) 
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
-      !!  
-      REAL(wp) ::   zcoef, zcoef1, zcoef2 
-      REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask      ! land/sea mask for field 
-      REAL(wp), POINTER, DIMENSION(:,:)        :: bdypmask      ! land/sea mask for field 
-      INTEGER  ::   ib, ik   ! dummy loop indices 
-      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
-      !!---------------------------------------------------------------------- 
-      ! 
-      IF( nn_timing == 1 ) CALL timing_start('bdy_nmn') 
-      ! 
-      SELECT CASE(igrd) 
-         CASE(1) 
-            pmask => tmask(:,:,:) 
-            bdypmask => bdytmask(:,:) 
-         CASE(2) 
-            pmask => umask(:,:,:) 
-            bdypmask => bdyumask(:,:) 
-         CASE(3) 
-            pmask => vmask(:,:,:) 
-            bdypmask => bdyvmask(:,:) 
-         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 
-      END SELECT 
-      DO ib = 1, idx%nblenrim(igrd) 
-         ii = idx%nbi(ib,igrd) 
-         ij = idx%nbj(ib,igrd) 
-         DO ik = 1, jpkm1 
-            ! search the sense of the gradient 
-            zcoef1 = bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik) +  bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) 
-            zcoef2 = bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik) +  bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) 
-            IF ( nint(zcoef1+zcoef2) == 0) THEN 
-               ! corner **** we probably only want to set the tangentail component for the dynamics here 
-               zcoef = pmask(ii-1,ij,ik) + pmask(ii+1,ij,ik) +  pmask(ii,ij-1,ik) +  pmask(ii,ij+1,ik) 
-               IF (zcoef > .5_wp) THEN ! Only set none isolated points. 
-                 phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik) + & 
-                   &              phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik) + & 
-                   &              phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik) + & 
-                   &              phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik) 
-                 phia(ii,ij,ik) = ( phia(ii,ij,ik) / zcoef ) * pmask(ii,ij,ik) 
-               ELSE 
-                 phia(ii,ij,ik) = phia(ii,ij  ,ik) * pmask(ii,ij  ,ik) 
-               ENDIF 
-            ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 
-               ! oblique corner **** we probably only want to set the normal component for the dynamics here 
-               zcoef = pmask(ii-1,ij,ik)*bdypmask(ii-1,ij  ) + pmask(ii+1,ij,ik)*bdypmask(ii+1,ij  ) + & 
-                   &   pmask(ii,ij-1,ik)*bdypmask(ii,ij -1 ) +  pmask(ii,ij+1,ik)*bdypmask(ii,ij+1  ) 
-               phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik)*bdypmask(ii-1,ij  ) + & 
-                   &            phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik)*bdypmask(ii+1,ij  )  + & 
-                   &            phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik)*bdypmask(ii,ij -1 ) + & 
-                   &            phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik)*bdypmask(ii,ij+1  ) 
-   
-               phia(ii,ij,ik) = ( phia(ii,ij,ik) / MAX(1._wp, zcoef) ) * pmask(ii,ij,ik) 
-            ELSE 
-               ip = nint(bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik)) 
-               jp = nint(bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik)) 
-               phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) 
-            ENDIF 
-         END DO 
-      END DO 
-      ! 
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn') 
-      ! 
-   END SUBROUTINE bdy_nmn 
-
 
 #else
@@ -440,7 +366,4 @@
       WRITE(*,*) 'bdy_orlanski_3d: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_orlanski_3d
-   SUBROUTINE bdy_nmn( idx, igrd, phia )      ! Empty routine 
-      WRITE(*,*) 'bdy_nmn: You should not have seen this print! error?', kt 
-   END SUBROUTINE bdy_nmn 
 #endif
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 10251)
@@ -50,9 +50,4 @@
       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V    (after nodal cor.)
    END TYPE TIDES_DATA
-   INTEGER, PUBLIC, PARAMETER                  ::   jptides_max = 15      !: Max number of tidal contituents
-      LOGICAL, PUBLIC                           ::   ln_harm_ana_store    !: =T Stores data for  harmonic Analysis
-      LOGICAL, PUBLIC                           ::   ln_harm_ana_compute     !: =T  Compute harmonic Analysis
-      LOGICAL, PUBLIC                           ::   ln_harmana_read         !: =T  Decide to do the analysis 
-                                                                             !from scratch or continue previous run
 
 !$AGRIF_DO_NOT_TREAT
@@ -95,5 +90,5 @@
       TYPE(MAP_POINTER), DIMENSION(jpbgrd)      ::   ibmap_ptr           !: array of pointers to nbmap
       !!
-      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj, ln_harm_ana_store, ln_harm_ana_compute, ln_harmana_read
+      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
       !!----------------------------------------------------------------------
 
@@ -107,5 +102,4 @@
 
       REWIND(numnam_cfg)
-      REWIND(numnam_ref)   ! slwa
 
       DO ib_bdy = 1, nb_bdy
@@ -131,7 +125,4 @@
             IF(lwp) WRITE(numout,*) '             assume complex conjugate   : ', ln_bdytide_conj
             IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo
-            IF(lwp) WRITE(numout,*) '             Use PCOMS harmonic ananalysis or not: ', ln_harm_ana_store
-            IF(lwp) WRITE(numout,*) '             Compute Final  harmonic ananalysis or not: ', ln_harm_ana_compute
-            IF(lwp) WRITE(numout,*) '             Read in previous days harmonic data or start afresh: ', ln_harmana_read
             IF(lwp) THEN 
                     WRITE(numout,*) '             Tidal components: ' 
@@ -425,5 +416,5 @@
       ! Absolute time from model initialization:   
       IF( PRESENT(kit) ) THEN  
-         z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt
+         z_arg = ( kt + (kit+0.5_wp*(time_add-1)) / REAL(nn_baro,wp) ) * rdt
       ELSE                              
          z_arg = ( kt + time_add ) * rdt
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 10251)
@@ -91,7 +91,6 @@
       !! 
       REAL(wp) ::   zwgt           ! boundary weight
-      REAL(wp) ::   zcoef, zcoef1,zcoef2 
-      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
-      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! 2D addresses
       !!----------------------------------------------------------------------
       !
@@ -161,7 +160,6 @@
       !! 
       REAL(wp) ::   zwgt           ! boundary weight
-      REAL(wp) ::   zcoef, zcoef1,zcoef2 
-      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
-      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses
       !!----------------------------------------------------------------------
       !
@@ -176,5 +174,5 @@
             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
-            IF ( NINT(zcoef1+zcoef2) == 0) THEN 
+            IF ( zcoef1+zcoef2 == 0) THEN
                ! corner
                zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik)
@@ -183,13 +181,13 @@
                  &                    tsa(ii  ,ij-1,ik,jp_tem) * tmask(ii  ,ij-1,ik) + &
                  &                    tsa(ii  ,ij+1,ik,jp_tem) * tmask(ii  ,ij+1,ik)
-               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1._wp, zcoef) ) * tmask(ii,ij,ik) 
+               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
                tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij  ,ik,jp_sal) * tmask(ii-1,ij  ,ik) + &
                  &                    tsa(ii+1,ij  ,ik,jp_sal) * tmask(ii+1,ij  ,ik) + &
                  &                    tsa(ii  ,ij-1,ik,jp_sal) * tmask(ii  ,ij-1,ik) + &
                  &                    tsa(ii  ,ij+1,ik,jp_sal) * tmask(ii  ,ij+1,ik)
-               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1._wp, zcoef) ) * tmask(ii,ij,ik)
+               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
             ELSE
-               ip = NINT(bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )) 
-               jp = NINT(bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)) 
+               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
+               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
                tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik)
                tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik)
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 10251)
@@ -91,5 +91,5 @@
       ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
       ! -----------------------------------------------------------------------
-      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
+      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
       IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
 
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 10250)
+++ 	(revision )
@@ -1,373 +1,0 @@
-MODULE dia25h 
-   !!======================================================================
-   !!                       ***  MODULE  diaharm  ***
-   !! Harmonic analysis of tidal constituents 
-   !!======================================================================
-   !! History :  3.6  !  2014  (E O'Dea)  Original code
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   USE diainsitutem, ONLY: rinsitu_t, theta2t
-   USE in_out_manager  ! I/O units
-   USE iom             ! I/0 library
-   USE wrk_nemo        ! working arrays
-#if defined key_zdftke 
-   USE zdftke, ONLY: en
-#endif
-   USE zdf_oce, ONLY: avt, avm
-#if defined key_zdfgls
-   USE zdfgls, ONLY: mxln
-   USE zdf_oce, ONLY: en
-#endif
-   USE diatmb
-
-   IMPLICIT NONE
-   PRIVATE
-
-   LOGICAL , PUBLIC ::   ln_dia25h     !:  25h mean output
-   PUBLIC   dia_25h_init               ! routine called by nemogcm.F90
-   PUBLIC   dia_25h                    ! routine called by diawri.F90
-
-  !! * variables for calculating 25-hourly means
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h, rinsitu_t_25h  
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h, insitu_bot_25h, temp_bot_25h 
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h
-#if defined key_zdfgls || key_zdftke
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_25h
-#endif
-#if defined key_zdfgls 
-   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h
-#endif
-   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means
-
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dia_25h_init 
-      !!---------------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_25h_init  ***
-      !!     
-      !! ** Purpose: Initialization of 25h mean namelist 
-      !!        
-      !! ** Method : Read namelist
-      !!   History
-      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_25h
-      !!---------------------------------------------------------------------------
-      !!
-      INTEGER ::   ios                 ! Local integer output status for namelist read
-      INTEGER ::   ierror              ! Local integer for memory allocation
-      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace
-      !
-      NAMELIST/nam_dia25h/ ln_dia25h
-      !!----------------------------------------------------------------------
-      !
-      REWIND ( numnam_ref )              ! Read Namelist nam_dia25h in reference namelist : 25hour mean diagnostics
-      READ   ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist nam_dia25h in configuration namelist  25hour diagnostics
-      READ  ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, nam_dia25h )
-
-      IF(lwp) THEN                   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dia_25h_init : Output 25 hour mean diagnostics'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) 'Namelist nam_dia25h : set 25h outputs '
-         WRITE(numout,*) 'Switch for 25h diagnostics (T) or not (F)  ln_dia25h  = ', ln_dia25h
-      ENDIF
-      IF( .NOT. ln_dia25h )   RETURN
-      ! ------------------- !
-      ! 1 - Allocate memory !
-      ! ------------------- !
-      ALLOCATE( tn_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate tn_25h' )   ;   RETURN
-      ENDIF
-      ALLOCATE( sn_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' )   ;   RETURN
-      ENDIF
-      ALLOCATE( rinsitu_t_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate rinsitu_t_25h' )   ;   RETURN
-      ENDIF
-      ALLOCATE( insitu_bot_25h(jpi,jpj), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate insitu_bot_25h' )   ;   RETURN
-      ENDIF      
-      ALLOCATE( temp_bot_25h(jpi,jpj), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate temp_bot_25h' )   ;   RETURN
-      ENDIF                           
-      ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate un_25h' )   ;   RETURN
-      ENDIF
-      ALLOCATE( vn_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate vn_25h' )   ;   RETURN
-      ENDIF
-      ALLOCATE( wn_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate wn_25h' )   ;   RETURN
-      ENDIF
-      ALLOCATE( avt_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate avt_25h' )   ;   RETURN
-      ENDIF
-      ALLOCATE( avm_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate avm_25h' )   ;   RETURN
-      ENDIF
-# if defined key_zdfgls || defined key_zdftke
-      ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate en_25h' )   ;   RETURN
-      ENDIF
-#endif
-# if defined key_zdfgls 
-      ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' )   ;   RETURN
-      ENDIF
-#endif
-      ALLOCATE( sshn_25h(jpi,jpj), STAT=ierror )
-      IF( ierror > 0 ) THEN
-         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN
-      ENDIF
-      ! ------------------------- !
-      ! 2 - Assign Initial Values !
-      ! ------------------------- !
-      cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible) 
-      tn_25h(:,:,:) = tsb(:,:,:,jp_tem)
-      sn_25h(:,:,:) = tsb(:,:,:,jp_sal)
-      CALL theta2t
-      rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:)
-      CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
-      insitu_bot_25h(:,:) = zwtmb(:,:,3)
-      CALL dia_calctmb( tn_25h(:,:,:),zwtmb )
-      temp_bot_25h(:,:) = zwtmb(:,:,3)
-      sshn_25h(:,:) = sshb(:,:)
-      un_25h(:,:,:) = ub(:,:,:)
-      vn_25h(:,:,:) = vb(:,:,:)
-      wn_25h(:,:,:) = wn(:,:,:)
-      avt_25h(:,:,:) = avt(:,:,:)
-      avm_25h(:,:,:) = avm(:,:,:)
-# if defined key_zdfgls || defined key_zdftke
-         en_25h(:,:,:) = en(:,:,:)
-#endif
-# if defined key_zdfgls
-         rmxln_25h(:,:,:) = mxln(:,:,:)
-#endif
-#if defined key_lim3 || defined key_lim2
-         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice')
-#endif 
-
-      ! -------------------------- !
-      ! 3 - Return to dia_wri      !
-      ! -------------------------- !
-
-
-   END SUBROUTINE dia_25h_init
-
-
-   SUBROUTINE dia_25h( kt )  
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE dia_25h  ***
-      !!         
-      !!
-      !!--------------------------------------------------------------------
-      !!                   
-      !! ** Purpose :   Write diagnostics with M2/S2 tide removed
-      !!
-      !! ** Method  :   
-      !!      25hr mean outputs for shelf seas
-      !!
-      !! History :
-      !!   ?.0  !  07-04  (A. Hines) New routine, developed from dia_wri_foam
-      !!   3.4  !  02-13  (J. Siddorn) Routine taken from old dia_wri_foam
-      !!   3.6  !  08-14  (E. O'Dea) adapted for VN3.6
-      !!----------------------------------------------------------------------
-      !! * Modules used
-
-      IMPLICIT NONE
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk
-
-      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout
-      REAL(wp)                         ::   zsto, zout, zmax, zjulian, zdt, zmdi  ! temporary reals
-      INTEGER                          ::   i_steps                               ! no of timesteps per hour
-      REAL(wp), DIMENSION(jpi,jpj    ) ::   zw2d, un_dm, vn_dm                    ! temporary workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                                  ! temporary workspace
-      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace
-      INTEGER                          ::   iyear0, nimonth0,iday0                ! start year,imonth,day
-
-      !!----------------------------------------------------------------------
-
-      ! 0. Initialisation
-      ! -----------------
-      ! Define frequency of summing to create 25 h mean
-      zdt = rdt
-      IF( nacc == 1 ) zdt = rdtmin
-
-      IF( MOD( 3600,INT(zdt) ) == 0 ) THEN
-         i_steps = 3600/INT(zdt)
-      ELSE
-         CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible')
-      ENDIF
-
-#if defined key_lim3 || defined key_lim2
-      CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice')
-#endif
-
-      ! local variable for debugging
-      ll_print = ll_print .AND. lwp
-
-      ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours
-      ! every day
-      IF( MOD( kt, i_steps ) == 0  .and. kt .ne. nn_it000 ) THEN
-
-         IF (lwp) THEN
-              WRITE(numout,*) 'dia_wri_tide : Summing instantaneous hourly diagnostics at timestep ',kt
-              WRITE(numout,*) '~~~~~~~~~~~~ '
-         ENDIF
-
-         tn_25h(:,:,:)        = tn_25h(:,:,:) + tsn(:,:,:,jp_tem)
-         sn_25h(:,:,:)        = sn_25h(:,:,:) + tsn(:,:,:,jp_sal)
-         CALL theta2t
-         rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) + rinsitu_t(:,:,:)
-         CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
-         insitu_bot_25h(:,:)  = insitu_bot_25h(:,:) + zwtmb(:,:,3)
-         zw3d(:,:,:)          = tsn(:,:,:,jp_tem)
-         CALL dia_calctmb( zw3d,zwtmb )
-         temp_bot_25h(:,:)    = temp_bot_25h(:,:) + zwtmb(:,:,3)
-         sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:)
-         un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:)
-         vn_25h(:,:,:)        = vn_25h(:,:,:) + vn(:,:,:)
-         wn_25h(:,:,:)        = wn_25h(:,:,:) + wn(:,:,:)
-         avt_25h(:,:,:)       = avt_25h(:,:,:) + avt(:,:,:)
-         avm_25h(:,:,:)       = avm_25h(:,:,:) + avm(:,:,:)
-# if defined key_zdfgls || defined key_zdftke
-         en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:)
-#endif
-# if defined key_zdfgls
-         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:)
-#endif
-         cnt_25h = cnt_25h + 1
-
-         IF (lwp) THEN
-            WRITE(numout,*) 'dia_tide : Summed the following number of hourly values so far',cnt_25h
-         ENDIF
-
-      ENDIF ! MOD( kt, i_steps ) == 0
-
-         ! Write data for 25 hour mean output streams
-      IF( cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
-
-            IF(lwp) THEN
-               WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt
-               WRITE(numout,*) '~~~~~~~~~~~~ '
-            ENDIF
-
-            tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp
-            sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp
-            rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) / 25.0_wp
-            insitu_bot_25h(:,:)  = insitu_bot_25h(:,:) / 25.0_wp 
-            temp_bot_25h(:,:)    = temp_bot_25h(:,:) /25.0_wp
-            sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp
-            un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp
-            vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp
-            wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp
-            avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp
-            avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp
-# if defined key_zdfgls || defined key_zdftke
-            en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp
-#endif
-# if defined key_zdfgls
-            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp
-#endif
-
-            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output'
-            zmdi=1.e+20 !missing data indicator for masking
-            ! write tracers (instantaneous)
-            zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
-            CALL iom_put("temper25h", zw3d)   ! potential temperature
-            CALL theta2t                                                                    ! calculate insitu temp
-            zw3d(:,:,:) = rinsitu_t_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
-            CALL iom_put("tempis25h", zw3d)   ! in-situ temperature
-            zw2d(:,:) = insitu_bot_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
-            CALL iom_put("tempisbot25h", zw2d) ! bottom in-situ temperature
-            zw2d(:,:) = temp_bot_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
-            CALL iom_put("temperbot25h",zw2d) ! bottom potential temperature
-            zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
-            CALL iom_put( "salin25h", zw3d  )   ! salinity
-            zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
-            CALL iom_put( "ssh25h", zw2d )   ! sea surface 
-
-
-            ! Write velocities (instantaneous)
-            zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:))
-            CALL iom_put("vozocrtx25h", zw3d)    ! i-current
-            zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:))
-            CALL iom_put("vomecrty25h", zw3d  )   ! j-current
-
-            zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
-            CALL iom_put("vomecrtz25h", zw3d )   ! k-current
-            zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
-            CALL iom_put("avt25h", zw3d )   ! diffusivity
-            zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
-            CALL iom_put("avm25h", zw3d)   ! viscosity
-#if defined key_zdftke || defined key_zdfgls 
-!           zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
-!           CALL iom_put("tke25h", zw3d)   ! tke
-#endif
-#if defined key_zdfgls 
-!           zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
-!           CALL iom_put( "mxln25h",zw3d)
-#endif
-
-            ! After the write reset the values to cnt=1 and sum values equal current value 
-            tn_25h(:,:,:) = tsn(:,:,:,jp_tem)
-            sn_25h(:,:,:) = tsn(:,:,:,jp_sal)
-            CALL theta2t
-            rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:)
-            CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
-            insitu_bot_25h(:,:) = zwtmb(:,:,3)
-            CALL dia_calctmb( tn_25h(:,:,:),zwtmb)
-            temp_bot_25h(:,:) = zwtmb(:,:,3)
-            sshn_25h(:,:) = sshn (:,:)
-            un_25h(:,:,:) = un(:,:,:)
-            vn_25h(:,:,:) = vn(:,:,:)
-            wn_25h(:,:,:) = wn(:,:,:)
-            avt_25h(:,:,:) = avt(:,:,:)
-            avm_25h(:,:,:) = avm(:,:,:)
-# if defined key_zdfgls || defined key_zdftke
-            en_25h(:,:,:) = en(:,:,:)
-#endif
-# if defined key_zdfgls
-            rmxln_25h(:,:,:) = mxln(:,:,:)
-#endif
-            cnt_25h = 1
-            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h
-
-      ENDIF !  cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000
-
-
-   END SUBROUTINE dia_25h 
-
-   !!======================================================================
-END MODULE dia25h
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 10251)
@@ -59,5 +59,4 @@
   PRIVATE  transport
   PRIVATE  dia_dct_wri
-  PRIVATE  dia_dct_wri_NOOS
 
 #include "domzgr_substitute.h90"
@@ -67,16 +66,14 @@
 
   !! * Module variables
-  INTEGER :: nn_dct      = 1     ! Frequency of computation
-  INTEGER :: nn_dctwri   = 1     ! Frequency of output
-  INTEGER :: nn_secdebug = 0     ! Number of the section to debug
-  INTEGER :: nn_dct_h    = 1     ! Frequency of computation for NOOS hourly files
-  INTEGER :: nn_dctwri_h = 1     ! Frequency of output for NOOS hourly files
+  INTEGER :: nn_dct        ! Frequency of computation
+  INTEGER :: nn_dctwri     ! Frequency of output
+  INTEGER :: nn_secdebug   ! Number of the section to debug
    
-  INTEGER, PARAMETER :: nb_class_max  = 12   ! maximum number of classes, i.e. depth levels or density classes
-  INTEGER, PARAMETER :: nb_sec_max    = 30   ! maximum number of sections
-  INTEGER, PARAMETER :: nb_point_max  = 300  ! maximum number of points in a single section
-  INTEGER, PARAMETER :: nb_type_class       = 14   ! types of calculations, i.e. pos transport, neg transport, heat transport, salt transport
-  INTEGER, PARAMETER :: nb_3d_vars    = 5
-  INTEGER, PARAMETER :: nb_2d_vars    = 2
+  INTEGER, PARAMETER :: nb_class_max  = 10
+  INTEGER, PARAMETER :: nb_sec_max    = 150
+  INTEGER, PARAMETER :: nb_point_max  = 2000
+  INTEGER, PARAMETER :: nb_type_class = 10
+  INTEGER, PARAMETER :: nb_3d_vars    = 3 
+  INTEGER, PARAMETER :: nb_2d_vars    = 2 
   INTEGER            :: nb_sec 
 
@@ -105,5 +102,4 @@
                                                      zlay              ! level classes      (99 if you don't want)
      REAL(wp), DIMENSION(nb_type_class,nb_class_max)  :: transport     ! transport output
-     REAL(wp), DIMENSION(nb_type_class,nb_class_max)  :: transport_h   ! transport output
      REAL(wp)                                         :: slopeSection  ! slope of the section
      INTEGER                                          :: nb_point      ! number of points in the section
@@ -115,7 +111,4 @@
   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d 
   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d  
-  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d_h
-  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d_h
-  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  z_hr_output
 
    !! $Id$
@@ -127,12 +120,9 @@
      !!                   ***  FUNCTION diadct_alloc  *** 
      !!---------------------------------------------------------------------- 
-     INTEGER :: ierr(5) 
+     INTEGER :: ierr(2) 
      !!---------------------------------------------------------------------- 
 
-     ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk)  , STAT=ierr(1) ) 
-     ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)      , STAT=ierr(2) ) 
-     ALLOCATE(transports_3d_h(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(3) )
-     ALLOCATE(transports_2d_h(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=ierr(4) )
-     ALLOCATE(z_hr_output(nb_sec_max,168,nb_class_max)               , STAT=ierr(5) ) ! 168 = 24 * 7days
+     ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) ) 
+     ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=ierr(2) ) 
 
      diadct_alloc = MAXVAL( ierr ) 
@@ -163,24 +153,10 @@
      IF(lwm) WRITE ( numond, namdct )
 
-     IF( ln_NOOS ) THEN
-        nn_dct=3600./rdt         ! hard coded for NOOS transects, to give 25 hour means 
-        nn_dctwri=86400./rdt
-        nn_dct_h=1       ! hard coded for NOOS transects, to give hourly data
-        nn_dctwri_h=3600./rdt
-     ENDIF
-
      IF( lwp ) THEN
         WRITE(numout,*) " "
         WRITE(numout,*) "diadct_init: compute transports through sections "
         WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
-        IF( ln_NOOS ) THEN
-           WRITE(numout,*) "       Frequency of computation hard coded to be every hour: nn_dct    = ",nn_dct
-           WRITE(numout,*) "       Frequency of write hard coded to average 25 instantaneous hour values: nn_dctwri = ",nn_dctwri
-           WRITE(numout,*) "       Frequency of hourly computation hard coded to be every timestep: nn_dct_h  = ",nn_dct_h
-           WRITE(numout,*) "       Frequency of hourly write hard coded to every hour: nn_dctwri_h = ",nn_dctwri_h
-        ELSE
-           WRITE(numout,*) "       Frequency of computation: nn_dct    = ",nn_dct
-           WRITE(numout,*) "       Frequency of write:       nn_dctwri = ",nn_dctwri
-        ENDIF
+        WRITE(numout,*) "       Frequency of computation: nn_dct    = ",nn_dct
+        WRITE(numout,*) "       Frequency of write:       nn_dctwri = ",nn_dctwri
 
         IF      ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN
@@ -201,20 +177,12 @@
      !open output file
      IF( lwm ) THEN
-        IF( ln_NOOS ) THEN
-           CALL ctl_opn( numdct_NOOS  ,'NOOS_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-           CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_h', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-        ELSE
-           CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-           CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-           CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-        ENDIF
+        CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
      ENDIF
 
      ! Initialise arrays to zero 
-     transports_3d(:,:,:,:)  =0.0 
-     transports_2d(:,:,:)    =0.0 
-     transports_3d_h(:,:,:,:)=0._wp
-     transports_2d_h(:,:,:)  =0._wp
-     z_hr_output(:,:,:)      =0._wp
+     transports_3d(:,:,:,:)=0.0 
+     transports_2d(:,:,:)  =0.0 
 
      IF( nn_timing == 1 )   CALL timing_stop('dia_dct_init')
@@ -261,5 +229,5 @@
         CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum  )
      ENDIF    
-     lldebug=.TRUE.
+ 
      ! Initialise arrays
      zwork(:) = 0.0 
@@ -275,10 +243,10 @@
  
      ! Compute transport and write only at nn_dctwri
-     IF( MOD(kt,nn_dct)==0 .or. &                ! compute transport every nn_dct time steps
-         (ln_NOOS .and. kt==nn_it000 ) )  THEN   ! also include first time step when calculating NOOS 25 hour averages
+     IF( MOD(kt,nn_dct)==0 ) THEN 
 
         DO jsec=1,nb_sec
 
            !debug this section computing ?
+           lldebug=.FALSE.
            IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND.  kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 
 
@@ -303,5 +271,4 @@
            !Sum on all procs 
            IF( lk_mpp )THEN
-              zsum(:,:,:)=0.0_wp
               ish(1)  =  nb_sec_max*nb_type_class*nb_class_max 
               ish2    = (/nb_sec_max,nb_type_class,nb_class_max/)
@@ -316,12 +283,10 @@
            DO jsec=1,nb_sec
 
-              IF( lwm .and. .not. ln_NOOS )CALL dia_dct_wri(kt,jsec,secs(jsec))
-              IF( lwm .and.       ln_NOOS )CALL dia_dct_wri_NOOS(kt,jsec,secs(jsec))   ! use NOOS specific formatting
+              IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec))
             
               !nullify transports values after writing
               transports_3d(:,jsec,:,:)=0.
               transports_2d(:,jsec,:  )=0.
-              secs(jsec)%transport(:,:)=0. 
-              IF ( ln_NOOS ) CALL transport(secs(jsec),lldebug,jsec)  ! reinitialise for next 25 hour instantaneous average (overlapping values)
+              secs(jsec)%transport(:,:)=0.  
 
            ENDDO
@@ -330,57 +295,4 @@
 
      ENDIF
-
-     IF ( MOD(kt,nn_dct_h)==0 ) THEN            ! compute transport every nn_dct_h time steps
-
-        DO jsec=1,nb_sec
-
-           !lldebug=.FALSE.
-           IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND.  kt==nit000+nn_dct_h-1 .AND. lwp ) lldebug=.TRUE. 
-
-           !Compute transport through section  
-           CALL transport_h(secs(jsec),lldebug,jsec) 
-
-        ENDDO
-             
-        IF( MOD(kt,nn_dctwri_h)==0 )THEN
-
-           IF( lwp .AND. kt==nit000+nn_dctwri_h-1 )WRITE(numout,*)"      diadct: average and write hourly files at kt = ",kt         
-  
-           !! divide arrays by nn_dctwri/nn_dct to obtain average
-           transports_3d_h(:,:,:,:)=transports_3d_h(:,:,:,:)/(nn_dctwri_h/nn_dct_h)
-           transports_2d_h(:,:,:)  =transports_2d_h(:,:,:)  /(nn_dctwri_h/nn_dct_h)
-
-           ! Sum over each class
-           DO jsec=1,nb_sec
-              CALL dia_dct_sum_h(secs(jsec),jsec)
-           ENDDO
- 
-           !Sum on all procs 
-          IF( lk_mpp )THEN
-              ish(1)  =  nb_sec_max*nb_type_class*nb_class_max 
-              ish2    = (/nb_sec_max,nb_type_class,nb_class_max/)
-              DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport_h(:,:) ; ENDDO
-              zwork(:)= RESHAPE(zsum(:,:,:), ish )
-              CALL mpp_sum(zwork, ish(1))
-              zsum(:,:,:)= RESHAPE(zwork,ish2)
-              DO jsec=1,nb_sec ; secs(jsec)%transport_h(:,:) = zsum(jsec,:,:) ; ENDDO
-           ENDIF
-
-           !Write the transport
-           DO jsec=1,nb_sec
-
-              IF( lwp .and.       ln_NOOS )CALL dia_dct_wri_NOOS_h(kt/nn_dctwri_h,jsec,secs(jsec))   ! use NOOS specific formatting
-            
-              !nullify transports values after writing
-              transports_3d_h(:,jsec,:,:)=0.0
-              transports_2d_h(:,jsec,:)=0.0
-              secs(jsec)%transport_h(:,:)=0.  
-              IF ( ln_NOOS ) CALL transport_h(secs(jsec),lldebug,jsec)  ! reinitialise for next 25 hour instantaneous average (overlapping values)
-
-           ENDDO
-
-        ENDIF 
-
-     ENDIF    
 
      IF( lk_mpp )THEN
@@ -444,12 +356,11 @@
         secs(jsec)%zlay         = 99._wp         
         secs(jsec)%transport    =  0._wp   ; secs(jsec)%nb_point       = 0
-        secs(jsec)%transport_h  =  0._wp   ; secs(jsec)%nb_point       = 0
 
         !read section's number / name / computing choices / classes / slopeSection / points number
         !-----------------------------------------------------------------------------------------
         READ(numdct_in,iostat=iost)isec
-        IF (iost .NE. 0 )EXIT !end of file
+        IF (iost .NE. 0 )EXIT !end of file 
         WRITE(cltmp,'(a,i4.4,a,i4.4)')'diadct: read sections : Problem of section number: isec= ',isec,' and jsec= ',jsec
-        IF( jsec .NE. isec )CALL ctl_stop( cltmp )
+        IF( jsec .NE. isec )  CALL ctl_stop( cltmp )
 
         IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )WRITE(numout,*)"isec ",isec 
@@ -469,10 +380,4 @@
         READ(numdct_in)iptglo
 
-        IF ( ln_NOOS ) THEN
-           WRITE(numout,*) 'Section name = ',TRIM(secs(jsec)%name)
-           WRITE(numout,*) 'coordSec = ',secs(jsec)%coordSec
-           WRITE(numout,*) 'iptglo = ',iptglo
-        ENDIF
-
         !debug
         !-----
@@ -500,8 +405,4 @@
            !read points'coordinates and directions 
            !--------------------------------------
-           IF ( ln_NOOS ) THEN
-              WRITE(numout,*) 'Coords and direction read'
-           ENDIF
-
            coordtemp(:) = POINT_SECTION(0,0) !list of points read
            directemp(:) = 0                  !value of directions of each points
@@ -521,5 +422,5 @@
               ENDDO                  
            ENDIF
-
+ 
            !Now each proc selects only points that are in its domain:
            !--------------------------------------------------------
@@ -723,5 +624,5 @@
      !!--------------------------------------------------------
 
-     !!NIALL IF( ld_debug )WRITE(numout,*)'      Compute transport'
+     IF( ld_debug )WRITE(numout,*)'      Compute transport'
 
      !---------------------------!
@@ -809,14 +710,14 @@
               SELECT CASE( sec%direction(jseg) ) 
               CASE(0,1) 
-                 ztn   = interp(k%I,k%J,jk,'V',0 ) 
-                 zsn   = interp(k%I,k%J,jk,'V',1 ) 
-                 zrhop = interp(k%I,k%J,jk,'V',2 ) 
-                 zrhoi = interp(k%I,k%J,jk,'V',3 ) 
+                 ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
+                 zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
+                 zrhop = interp(k%I,k%J,jk,'V',rhop) 
+                 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1) 
               CASE(2,3) 
-                 ztn   = interp(k%I,k%J,jk,'U',0 ) 
-                 zsn   = interp(k%I,k%J,jk,'U',1 ) 
-                 zrhop = interp(k%I,k%J,jk,'U',2 ) 
-                 zrhoi = interp(k%I,k%J,jk,'U',3 ) 
+                 ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
+                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
+                 zrhop = interp(k%I,k%J,jk,'U',rhop) 
+                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
               END SELECT 
@@ -853,6 +754,4 @@
                  transports_3d(2,jsec,jseg,jk) = transports_3d(2,jsec,jseg,jk)  + zTnorm * ztn * zrhop * rcp
                  transports_3d(3,jsec,jseg,jk) = transports_3d(3,jsec,jseg,jk)  + zTnorm * zsn * zrhop * 0.001
-                 transports_3d(4,jsec,jseg,jk) = transports_3d(4,jsec,jseg,jk)  + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp
-                 transports_3d(5,jsec,jseg,jk) = transports_3d(5,jsec,jseg,jk)  + zTnorm * 0.001 * zsn * 1026._wp
               ENDIF
    
@@ -910,218 +809,4 @@
   END SUBROUTINE transport
   
-  SUBROUTINE transport_h(sec,ld_debug,jsec)
-     !!-------------------------------------------------------------------------------------------
-     !!                     ***  ROUTINE hourly_transport  ***
-     !!
-     !!              Exactly as routine transport but for data summed at
-     !!              each time step and averaged each hour
-     !!
-     !!  Purpose ::  Compute the transport for each point in a section
-     !!
-     !!  Method  ::  Loop over each segment, and each vertical level and add the transport
-     !!              Be aware :          
-     !!              One section is a sum of segments
-     !!              One segment is defined by 2 consecutive points in sec%listPoint
-     !!              All points of sec%listPoint are positioned on the F-point of the cell
-     !! 
-     !!              There are two loops:                 
-     !!              loop on the segment between 2 nodes
-     !!              loop on the level jk
-     !!
-     !! ** Output: Arrays containing the volume,density,salinity,temperature etc
-     !!            transports for each point in a section, summed over each nn_dct.
-     !!
-     !!-------------------------------------------------------------------------------------------
-     !! * Arguments
-     TYPE(SECTION),INTENT(INOUT) :: sec
-     LOGICAL      ,INTENT(IN)    :: ld_debug
-     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section
-    
-     !! * Local variables
-     INTEGER             :: jk,jseg,jclass,    &!loop on level/segment/classes 
-                            isgnu  , isgnv      !
-     REAL(wp):: zumid        , zvmid        ,  &!U/V velocity on a cell segment
-                zumid_ice    , zvmid_ice    ,  &!U/V ice velocity
-                zTnorm                          !transport of velocity through one cell's sides
-     REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
-
-     TYPE(POINT_SECTION) :: k
-     !!--------------------------------------------------------
-
-     !!NIALL IF( ld_debug )WRITE(numout,*)'      Compute transport'
-
-     !---------------------------!
-     !  COMPUTE TRANSPORT        !
-     !---------------------------!
-     IF(sec%nb_point .NE. 0)THEN   
-
-        !----------------------------------------------------------------------------------------------------
-        !Compute sign for velocities:
-        !
-        !convention:
-        !   non horizontal section: direction + is toward left hand of section
-        !       horizontal section: direction + is toward north of section
-        !
-        !
-        !       slopeSection < 0     slopeSection > 0       slopeSection=inf            slopeSection=0
-        !       ----------------      -----------------     ---------------             --------------
-        !
-        !   isgnv=1         direction +      
-        !  ______         _____             ______                                                   
-        !        |           //|            |                  |                         direction +   
-        !        | isgnu=1  // |            |isgnu=1           |isgnu=1                     /|\
-        !        |_______  //         ______|    \\            | ---\                        |
-        !               |             | isgnv=-1  \\ |         | ---/ direction +       ____________
-        !               |             |          __\\|         |                    
-        !               |             |     direction +        |                      isgnv=1                                 
-        !                                                      
-        !----------------------------------------------------------------------------------------------------
-        isgnu = 1
-        IF( sec%slopeSection .GT. 0 ) THEN  ; isgnv = -1 
-        ELSE                                ; isgnv =  1
-        ENDIF
-
-        IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv
-
-        !--------------------------------------!
-        ! LOOP ON THE SEGMENT BETWEEN 2 NODES  !
-        !--------------------------------------!
-        DO jseg=1,MAX(sec%nb_point-1,0)
-              
-           !-------------------------------------------------------------------------------------------
-           ! Select the appropriate coordinate for computing the velocity of the segment
-           !
-           !                      CASE(0)                                    Case (2)
-           !                      -------                                    --------
-           !  listPoint(jseg)                 listPoint(jseg+1)       listPoint(jseg)  F(i,j)      
-           !      F(i,j)----------V(i+1,j)-------F(i+1,j)                               |
-           !                                                                            |
-           !                                                                            |
-           !                                                                            |
-           !                      Case (3)                                            U(i,j)
-           !                      --------                                              |
-           !                                                                            |
-           !  listPoint(jseg+1) F(i,j+1)                                                |
-           !                        |                                                   |
-           !                        |                                                   |
-           !                        |                                 listPoint(jseg+1) F(i,j-1)
-           !                        |                                            
-           !                        |                                            
-           !                     U(i,j+1)                                            
-           !                        |                                       Case(1)     
-           !                        |                                       ------      
-           !                        |                                            
-           !                        |                 listPoint(jseg+1)             listPoint(jseg)                           
-           !                        |                 F(i-1,j)-----------V(i,j) -------f(jseg)                           
-           ! listPoint(jseg)     F(i,j)
-           ! 
-           !-------------------------------------------------------------------------------------------
-
-           SELECT CASE( sec%direction(jseg) )
-           CASE(0)  ;   k = sec%listPoint(jseg)
-           CASE(1)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
-           CASE(2)  ;   k = sec%listPoint(jseg)
-           CASE(3)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
-           END SELECT
-
-           !---------------------------|
-           !     LOOP ON THE LEVEL     |
-           !---------------------------|
-           !Sum of the transport on the vertical 
-           DO jk=1,mbathy(k%I,k%J)
-
-              ! compute temparature, salinity, insitu & potential density, ssh and depth at U/V point
-              SELECT CASE( sec%direction(jseg) )
-              CASE(0,1)
-                 ztn   = interp(k%I,k%J,jk,'V',0 )
-                 zsn   = interp(k%I,k%J,jk,'V',1)
-                 zrhop = interp(k%I,k%J,jk,'V',2)
-                 zrhoi = interp(k%I,k%J,jk,'V',3)
-                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)
-              CASE(2,3)
-                 ztn   = interp(k%I,k%J,jk,'U',0)
-                 zsn   = interp(k%I,k%J,jk,'U',1)
-                 zrhop = interp(k%I,k%J,jk,'U',2)
-                 zrhoi = interp(k%I,k%J,jk,'U',3)
-                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1) 
-              END SELECT
-
-              zfsdep= fsdept(k%I,k%J,jk)
- 
-              !compute velocity with the correct direction
-              SELECT CASE( sec%direction(jseg) )
-              CASE(0,1)  
-                 zumid=0.
-                 zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk)
-              CASE(2,3)
-                 zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk)
-                 zvmid=0.
-              END SELECT
-
-              !zTnorm=transport through one cell;
-              !velocity* cell's length * cell's thickness
-              zTnorm=zumid*e2u(k%I,k%J)*  fse3u(k%I,k%J,jk)+     &
-                     zvmid*e1v(k%I,k%J)*  fse3v(k%I,k%J,jk)
-
-#if ! defined key_vvl
-              !add transport due to free surface
-              IF( jk==1 )THEN
-                 zTnorm = zTnorm + zumid* e2u(k%I,k%J) * zsshn * umask(k%I,k%J,jk) + &
-                                   zvmid* e1v(k%I,k%J) * zsshn * vmask(k%I,k%J,jk)
-              ENDIF
-#endif
-              !COMPUTE TRANSPORT 
-
-              transports_3d_h(1,jsec,jseg,jk) = transports_3d_h(1,jsec,jseg,jk) + zTnorm
- 
-              IF ( sec%llstrpond ) THEN
-                 transports_3d_h(2,jsec,jseg,jk) = transports_3d_h(2,jsec,jseg,jk)  + zTnorm * zrhoi
-                 transports_3d_h(3,jsec,jseg,jk) = transports_3d_h(3,jsec,jseg,jk)  + zTnorm * zrhop
-                 transports_3d_h(4,jsec,jseg,jk) = transports_3d_h(4,jsec,jseg,jk)  + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp
-                 transports_3d_h(5,jsec,jseg,jk) = transports_3d_h(5,jsec,jseg,jk)  + zTnorm * 0.001 * zsn * 1026._wp
-              ENDIF
-
-           ENDDO !end of loop on the level
-
-#if defined key_lim2 || defined key_lim3
-
-           !ICE CASE    
-           !------------
-           IF( sec%ll_ice_section )THEN
-              SELECT CASE (sec%direction(jseg))
-              CASE(0)
-                 zumid_ice = 0
-                 zvmid_ice =  isgnv*0.5*(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
-              CASE(1)
-                 zumid_ice = 0
-                 zvmid_ice =  isgnv*0.5*(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
-              CASE(2)
-                 zvmid_ice = 0
-                 zumid_ice =  isgnu*0.5*(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
-              CASE(3)
-                 zvmid_ice = 0
-                 zumid_ice =  isgnu*0.5*(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
-              END SELECT
-   
-              zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J)
-   
-              transports_2d_h(1,jsec,jseg) = transports_2d_h(1,jsec,jseg) + (zTnorm)*   &
-                                   (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &
-                                  *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) +  &
-                                    hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &
-                                   +zice_vol_pos
-              transports_2d_h(2,jsec,jseg) = transports_2d_h(2,jsec,jseg) + (zTnorm)*   &
-                                    (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &
-                                   +zice_surf_pos
-   
-           ENDIF !end of ice case
-#endif
- 
-        ENDDO !end of loop on the segment
-
-     ENDIF   !end of sec%nb_point =0 case
-     !
-  END SUBROUTINE transport_h
- 
   SUBROUTINE dia_dct_sum(sec,jsec) 
      !!------------------------------------------------------------- 
@@ -1205,14 +890,14 @@
               SELECT CASE( sec%direction(jseg) ) 
               CASE(0,1) 
-                 ztn   = interp(k%I,k%J,jk,'V',0 ) 
-                 zsn   = interp(k%I,k%J,jk,'V',1 ) 
-                 zrhop = interp(k%I,k%J,jk,'V',2) 
-                 zrhoi = interp(k%I,k%J,jk,'V',3) 
+                 ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
+                 zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
+                 zrhop = interp(k%I,k%J,jk,'V',rhop) 
+                 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
 
               CASE(2,3) 
-                 ztn   = interp(k%I,k%J,jk,'U',0 ) 
-                 zsn   = interp(k%I,k%J,jk,'U',1 ) 
-                 zrhop = interp(k%I,k%J,jk,'U',2 ) 
-                 zrhoi = interp(k%I,k%J,jk,'U',3 ) 
+                 ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
+                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
+                 zrhop = interp(k%I,k%J,jk,'U',rhop) 
+                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
               END SELECT 
@@ -1272,16 +957,4 @@
                           sec%transport(6,jclass) = sec%transport(6,jclass)+transports_3d(3,jsec,jseg,jk) 
                        ENDIF 
-
-                       IF ( transports_3d(4,jsec,jseg,jk) .GE. 0.0 ) THEN
-                          sec%transport(7,jclass) = sec%transport(7,jclass)+transports_3d(4,jsec,jseg,jk)
-                       ELSE
-                          sec%transport(8,jclass) = sec%transport(8,jclass)+transports_3d(4,jsec,jseg,jk)
-                       ENDIF
-
-                       IF ( transports_3d(5,jsec,jseg,jk) .GE. 0.0 ) THEN
-                          sec%transport( 9,jclass) = sec%transport( 9,jclass)+transports_3d(5,jsec,jseg,jk)
-                       ELSE
-                          sec%transport(10,jclass) = sec%transport(10,jclass)+transports_3d(5,jsec,jseg,jk)
-                       ENDIF
  
                     ELSE 
@@ -1290,8 +963,4 @@
                        sec%transport( 5,jclass) = 0._wp 
                        sec%transport( 6,jclass) = 0._wp 
-                       sec%transport( 7,jclass) = 0._wp
-                       sec%transport( 8,jclass) = 0._wp
-                       sec%transport( 9,jclass) = 0._wp
-                       sec%transport(10,jclass) = 0._wp
                     ENDIF 
  
@@ -1308,13 +977,13 @@
  
               IF ( transports_2d(1,jsec,jseg) .GE. 0.0 ) THEN 
-                 sec%transport(11,1) = sec%transport(11,1)+transports_2d(1,jsec,jseg)*1.E-6 
+                 sec%transport( 7,1) = sec%transport( 7,1)+transports_2d(1,jsec,jseg)*1.E-6 
               ELSE 
-                 sec%transport(12,1) = sec%transport(12,1)+transports_2d(1,jsec,jseg)*1.E-6 
+                 sec%transport( 8,1) = sec%transport( 8,1)+transports_2d(1,jsec,jseg)*1.E-6 
               ENDIF 
  
               IF ( transports_2d(3,jsec,jseg) .GE. 0.0 ) THEN 
-                 sec%transport(13,1) = sec%transport(13,1)+transports_2d(2,jsec,jseg)*1.E-6 
+                 sec%transport( 9,1) = sec%transport( 9,1)+transports_2d(2,jsec,jseg)*1.E-6 
               ELSE 
-                 sec%transport(14,1) = sec%transport(14,1)+transports_2d(2,jsec,jseg)*1.E-6 
+                 sec%transport(10,1) = sec%transport(10,1)+transports_2d(2,jsec,jseg)*1.E-6 
               ENDIF 
  
@@ -1326,397 +995,10 @@
      ELSE  !if sec%nb_point =0 
         sec%transport(1:2,:)=0. 
-        IF (sec%llstrpond) sec%transport(3:10,:)=0. 
-        IF (sec%ll_ice_section) sec%transport(11:14,:)=0. 
+        IF (sec%llstrpond) sec%transport(3:6,:)=0. 
+        IF (sec%ll_ice_section) sec%transport(7:10,:)=0. 
      ENDIF !end of sec%nb_point =0 case 
  
   END SUBROUTINE dia_dct_sum 
-
-  SUBROUTINE dia_dct_sum_h(sec,jsec)
-     !!-------------------------------------------------------------
-     !! Exactly as dia_dct_sum but for hourly files containing data summed at each time step
-     !!
-     !! Purpose: Average the transport over nn_dctwri time steps 
-     !! and sum over the density/salinity/temperature/depth classes
-     !!
-     !! Method: 
-     !!           Sum over relevant grid cells to obtain values
-     !!           for each
-     !!              There are several loops:                 
-     !!              loop on the segment between 2 nodes
-     !!              loop on the level jk
-     !!              loop on the density/temperature/salinity/level classes
-     !!              test on the density/temperature/salinity/level
-     !!
-     !!  ** Method  :Transport through a given section is equal to the sum of transports
-     !!              computed on each proc.
-     !!              On each proc,transport is equal to the sum of transport computed through
-     !!              segments linking each point of sec%listPoint  with the next one.   
-     !!
-     !!-------------------------------------------------------------
-     !! * arguments
-     TYPE(SECTION),INTENT(INOUT) :: sec
-     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section
-
-     TYPE(POINT_SECTION) :: k
-     INTEGER  :: jk,jseg,jclass                        !loop on level/segment/classes 
-     REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
-     !!-------------------------------------------------------------
-
-     !! Sum the relevant segments to obtain values for each class
-     IF(sec%nb_point .NE. 0)THEN   
-
-        !--------------------------------------!
-        ! LOOP ON THE SEGMENT BETWEEN 2 NODES  !
-        !--------------------------------------!
-        DO jseg=1,MAX(sec%nb_point-1,0)
-           
-           !-------------------------------------------------------------------------------------------
-           ! Select the appropriate coordinate for computing the velocity of the segment
-           !
-           !                      CASE(0)                                    Case (2)
-           !                      -------                                    --------
-           !  listPoint(jseg)                 listPoint(jseg+1)       listPoint(jseg)  F(i,j)      
-           !      F(i,j)----------V(i+1,j)-------F(i+1,j)                               |
-           !                                                                            |
-           !                                                                            |
-           !                                                                            |
-           !                      Case (3)                                            U(i,j)
-           !                      --------                                              |
-           !                                                                            |
-           !  listPoint(jseg+1) F(i,j+1)                                                |
-           !                        |                                                   |
-           !                        |                                                   |
-           !                        |                                 listPoint(jseg+1) F(i,j-1)
-           !                        |                                            
-           !                        |                                            
-           !                     U(i,j+1)                                            
-           !                        |                                       Case(1)     
-           !                        |                                       ------      
-           !                        |                                            
-           !                        |                 listPoint(jseg+1)             listPoint(jseg)                           
-           !                        |                 F(i-1,j)-----------V(i,j) -------f(jseg)                           
-           ! listPoint(jseg)     F(i,j)
-           ! 
-           !-------------------------------------------------------------------------------------------
-
-           SELECT CASE( sec%direction(jseg) )
-           CASE(0)  ;   k = sec%listPoint(jseg)
-           CASE(1)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
-           CASE(2)  ;   k = sec%listPoint(jseg)
-           CASE(3)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
-           END SELECT
-
-           !---------------------------|
-           !     LOOP ON THE LEVEL     |
-           !---------------------------|
-           !Sum of the transport on the vertical 
-           DO jk=1,mbathy(k%I,k%J)
-
-              ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point
-              SELECT CASE( sec%direction(jseg) )
-              CASE(0,1)
-                 ztn   = interp(k%I,k%J,jk,'V',0 )
-                 zsn   = interp(k%I,k%J,jk,'V',1 )
-                 zrhop = interp(k%I,k%J,jk,'V',2 )
-                 zrhoi = interp(k%I,k%J,jk,'V',3 )
-                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)
-              CASE(2,3)
-                 ztn   = interp(k%I,k%J,jk,'U',0 )
-                 zsn   = interp(k%I,k%J,jk,'U',1 )
-                 zrhop = interp(k%I,k%J,jk,'U',2 )
-                 zrhoi = interp(k%I,k%J,jk,'U',3 )
-                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1) 
-              END SELECT
-
-              zfsdep= fsdept(k%I,k%J,jk)
- 
-              !-------------------------------
-              !  LOOP ON THE DENSITY CLASSES |
-              !-------------------------------
-              !The computation is made for each density/heat/salt/... class
-              DO jclass=1,MAX(1,sec%nb_class-1)
-
-                 !----------------------------------------------!
-                 !TEST ON THE DENSITY/SALINITY/TEMPERATURE/LEVEL! 
-                 !----------------------------------------------!
- 
-                 IF ( (                                                    &
-                    ((( zrhop .GE. (sec%zsigp(jclass)+1000.  )) .AND.      &
-                    (   zrhop .LE. (sec%zsigp(jclass+1)+1000. ))) .OR.     &
-                    ( sec%zsigp(jclass) .EQ. 99.)) .AND.                   &
-
-                    ((( zrhoi .GE. (sec%zsigi(jclass) + 1000.  )) .AND.    &
-                    (   zrhoi .LE. (sec%zsigi(jclass+1)+1000. ))) .OR.     &
-                    ( sec%zsigi(jclass) .EQ. 99.)) .AND.                   &
-
-                    ((( zsn .GT. sec%zsal(jclass)) .AND.                   &
-                    (   zsn .LE. sec%zsal(jclass+1))) .OR.                 &
-                    ( sec%zsal(jclass) .EQ. 99.)) .AND.                    &
-
-                    ((( ztn .GE. sec%ztem(jclass)) .AND.                   &
-                    (   ztn .LE. sec%ztem(jclass+1))) .OR.                 &
-                    ( sec%ztem(jclass) .EQ.99.)) .AND.                     &
-
-                    ((( zfsdep .GE. sec%zlay(jclass)) .AND.                &
-                    (   zfsdep .LE. sec%zlay(jclass+1))) .OR.              &
-                    ( sec%zlay(jclass) .EQ. 99. ))                         &
-                                                                   ))   THEN
-
-                    !SUM THE TRANSPORTS FOR EACH CLASSES FOR THE POSITIVE AND NEGATIVE DIRECTIONS
-                    !----------------------------------------------------------------------------
-                    IF (transports_3d_h(1,jsec,jseg,jk) .GE. 0.0) THEN 
-                       sec%transport_h(1,jclass) = sec%transport_h(1,jclass)+transports_3d_h(1,jsec,jseg,jk)
-                    ELSE
-                       sec%transport_h(2,jclass) = sec%transport_h(2,jclass)+transports_3d_h(1,jsec,jseg,jk)
-                    ENDIF
-                    IF( sec%llstrpond )THEN
-
-                       IF ( transports_3d_h(2,jsec,jseg,jk) .GE. 0.0 ) THEN 
-                          sec%transport_h(3,jclass) = sec%transport_h(3,jclass)+transports_3d_h(2,jsec,jseg,jk) 
-                       ELSE 
-                          sec%transport_h(4,jclass) = sec%transport_h(4,jclass)+transports_3d_h(2,jsec,jseg,jk) 
-                       ENDIF 
- 
-                       IF ( transports_3d_h(3,jsec,jseg,jk) .GE. 0.0 ) THEN 
-                          sec%transport_h(5,jclass) = sec%transport_h(5,jclass)+transports_3d_h(3,jsec,jseg,jk) 
-                       ELSE 
-                          sec%transport_h(6,jclass) = sec%transport_h(6,jclass)+transports_3d_h(3,jsec,jseg,jk) 
-                       ENDIF 
-
-                       IF ( transports_3d_h(4,jsec,jseg,jk) .GE. 0.0 ) THEN
-                          sec%transport_h(7,jclass) = sec%transport_h(7,jclass)+transports_3d_h(4,jsec,jseg,jk)
-                       ELSE
-                          sec%transport_h(8,jclass) = sec%transport_h(8,jclass)+transports_3d_h(4,jsec,jseg,jk)
-                       ENDIF
-
-                       IF ( transports_3d_h(5,jsec,jseg,jk) .GE. 0.0 ) THEN
-                          sec%transport_h( 9,jclass) = sec%transport_h( 9,jclass)+transports_3d_h(5,jsec,jseg,jk)
-                       ELSE
-                          sec%transport_h(10,jclass) = sec%transport_h(10,jclass)+transports_3d_h(5,jsec,jseg,jk)
-                       ENDIF
-
-                    ELSE
-                       sec%transport_h( 3,jclass) = 0._wp
-                       sec%transport_h( 4,jclass) = 0._wp
-                       sec%transport_h( 5,jclass) = 0._wp
-                       sec%transport_h( 6,jclass) = 0._wp
-                       sec%transport_h( 7,jclass) = 0._wp
-                       sec%transport_h( 8,jclass) = 0._wp
-                       sec%transport_h( 9,jclass) = 0._wp
-                       sec%transport_h(10,jclass) = 0._wp
-                    ENDIF
-
-                 ENDIF ! end of test if point is in class
-   
-              ENDDO ! end of loop on the classes
-
-           ENDDO ! loop over jk
-
-#if defined key_lim2 || defined key_lim3
-
-           !ICE CASE    
-           IF( sec%ll_ice_section )THEN
-
-              IF ( transports_2d_h(1,jsec,jseg) .GE. 0.0 ) THEN
-                 sec%transport_h(11,1) = sec%transport_h(11,1)+transports_2d_h(1,jsec,jseg)
-              ELSE
-                 sec%transport_h(12,1) = sec%transport_h(12,1)+transports_2d_h(1,jsec,jseg)
-              ENDIF
-
-              IF ( transports_2d_h(3,jsec,jseg) .GE. 0.0 ) THEN
-                 sec%transport_h(13,1) = sec%transport_h(13,1)+transports_2d_h(2,jsec,jseg)
-              ELSE
-                 sec%transport_h(14,1) = sec%transport_h(14,1)+transports_2d_h(2,jsec,jseg)
-              ENDIF
-
-           ENDIF !end of ice case
-#endif
- 
-        ENDDO !end of loop on the segment
-
-     ELSE  !if sec%nb_point =0
-        sec%transport_h(1:2,:)=0.
-        IF (sec%llstrpond) sec%transport_h(3:10,:)=0.
-        IF (sec%ll_ice_section) sec%transport_h( 11:14,:)=0.
-     ENDIF !end of sec%nb_point =0 case
-
-  END SUBROUTINE dia_dct_sum_h
   
-  SUBROUTINE dia_dct_wri_NOOS(kt,ksec,sec)
-     !!-------------------------------------------------------------
-     !! Write transport output in numdct using NOOS formatting 
-     !! 
-     !! Purpose: Write  transports in ascii files
-     !! 
-     !! Method:
-     !!        1. Write volume transports in "volume_transport"
-     !!           Unit: Sv : area * Velocity / 1.e6 
-     !! 
-     !!        2. Write heat transports in "heat_transport"
-     !!           Unit: Peta W : area * Velocity * T * rhau * Cp / 1.e15
-     !! 
-     !!        3. Write salt transports in "salt_transport"
-     !!           Unit: 10^9 g m^3 / s : area * Velocity * S / 1.e6
-     !!
-     !!------------------------------------------------------------- 
-     !!arguments
-     INTEGER, INTENT(IN)          :: kt          ! time-step
-     TYPE(SECTION), INTENT(INOUT) :: sec         ! section to write   
-     INTEGER ,INTENT(IN)          :: ksec        ! section number
-
-     !!local declarations
-     INTEGER               :: jclass,ji             ! Dummy loop
-     CHARACTER(len=2)      :: classe             ! Classname 
-     REAL(wp)              :: zbnd1,zbnd2        ! Class bounds
-     REAL(wp)              :: zslope             ! section's slope coeff
-     !
-     REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 
-     !!------------------------------------------------------------- 
-     CALL wrk_alloc(nb_type_class , zsumclasses )  
-
-     zsumclasses(:)=0._wp
-     zslope = sec%slopeSection       
-
-     WRITE(numdct_NOOS,'(I4,a1,I2,a1,I2,a12,i3,a17,i3,a10,a25)') nyear,'.',nmonth,'.',nday,'   Transect:',ksec-1,'   No. of layers:',sec%nb_class-1,'   Name: ',sec%name
-
-     DO jclass=1,MAX(1,sec%nb_class-1)
-        zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport(1:nb_type_class,jclass)
-     ENDDO
- 
-     classe   = 'total   '
-     zbnd1   = 0._wp
-     zbnd2   = 0._wp
-
-     IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
-        WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1),   &
-                                        -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7),   &
-                                        -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9)
-     ELSE
-        WRITE(numdct_NOOS,'(9e12.4E2)')   zsumclasses( 1)+zsumclasses( 2) ,  zsumclasses( 1), zsumclasses( 2),   &
-                                          zsumclasses( 7)+zsumclasses( 8) ,  zsumclasses( 7), zsumclasses( 8),   &
-                                          zsumclasses( 9)+zsumclasses(10) ,  zsumclasses( 9), zsumclasses(10)
-     ENDIF 
-
-     DO jclass=1,MAX(1,sec%nb_class-1)
-   
-        classe   = 'N       '
-        zbnd1   = 0._wp
-        zbnd2   = 0._wp
-
-        !insitu density classes transports
-        IF( ( sec%zsigi(jclass)   .NE. 99._wp ) .AND. &
-            ( sec%zsigi(jclass+1) .NE. 99._wp )       )THEN
-           classe = 'DI       '
-           zbnd1 = sec%zsigi(jclass)
-           zbnd2 = sec%zsigi(jclass+1)
-        ENDIF
-        !potential density classes transports
-        IF( ( sec%zsigp(jclass)   .NE. 99._wp ) .AND. &
-            ( sec%zsigp(jclass+1) .NE. 99._wp )       )THEN
-           classe = 'DP      '
-           zbnd1 = sec%zsigp(jclass)
-           zbnd2 = sec%zsigp(jclass+1)
-        ENDIF
-        !depth classes transports
-        IF( ( sec%zlay(jclass)    .NE. 99._wp ) .AND. &
-            ( sec%zlay(jclass+1)  .NE. 99._wp )       )THEN 
-           classe = 'Z       '
-           zbnd1 = sec%zlay(jclass)
-           zbnd2 = sec%zlay(jclass+1)
-        ENDIF
-        !salinity classes transports
-        IF( ( sec%zsal(jclass) .NE. 99._wp    ) .AND. &
-            ( sec%zsal(jclass+1) .NE. 99._wp  )       )THEN
-           classe = 'S       '
-           zbnd1 = sec%zsal(jclass)
-           zbnd2 = sec%zsal(jclass+1)   
-        ENDIF
-        !temperature classes transports
-        IF( ( sec%ztem(jclass) .NE. 99._wp     ) .AND. &
-            ( sec%ztem(jclass+1) .NE. 99._wp     )       ) THEN
-           classe = 'T       '
-           zbnd1 = sec%ztem(jclass)
-           zbnd2 = sec%ztem(jclass+1)
-        ENDIF
-                  
-        !write volume transport per class
-        IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
-           WRITE(numdct_NOOS,'(9e12.4E2)') -(sec%transport( 1,jclass)+sec%transport( 2,jclass)),-sec%transport( 2,jclass),-sec%transport( 1,jclass), &
-                                           -(sec%transport( 7,jclass)+sec%transport( 8,jclass)),-sec%transport( 8,jclass),-sec%transport( 7,jclass), &
-                                           -(sec%transport( 9,jclass)+sec%transport(10,jclass)),-sec%transport(10,jclass),-sec%transport( 9,jclass)
-        ELSE
-           WRITE(numdct_NOOS,'(9e12.4E2)')   sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), &
-                                             sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), &
-                                             sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass)
-        ENDIF
-
-     ENDDO
-
-     CALL wrk_dealloc(nb_type_class , zsumclasses )  
-
-  END SUBROUTINE dia_dct_wri_NOOS
-
-  SUBROUTINE dia_dct_wri_NOOS_h(hr,ksec,sec)
-     !!-------------------------------------------------------------
-     !! As routine dia_dct_wri_NOOS but for hourly output files
-     !!
-     !! Write transport output in numdct using NOOS formatting 
-     !! 
-     !! Purpose: Write  transports in ascii files
-     !! 
-     !! Method:
-     !!        1. Write volume transports in "volume_transport"
-     !!           Unit: Sv : area * Velocity / 1.e6 
-     !!
-     !!------------------------------------------------------------- 
-     !!arguments
-     INTEGER, INTENT(IN)          :: hr          ! hour
-     TYPE(SECTION), INTENT(INOUT) :: sec         ! section to write   
-     INTEGER ,INTENT(IN)          :: ksec        ! section number
-
-     !!local declarations
-     INTEGER               :: jclass,jhr            ! Dummy loop
-     CHARACTER(len=2)      :: classe             ! Classname 
-     REAL(wp)              :: zbnd1,zbnd2        ! Class bounds
-     REAL(wp)              :: zslope             ! section's slope coeff
-     !
-     REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 
-     !!------------------------------------------------------------- 
-
-     CALL wrk_alloc(nb_type_class , zsumclasses ) 
-
-     zsumclasses(:)=0._wp
-     zslope = sec%slopeSection       
-
-     DO jclass=1,MAX(1,sec%nb_class-1)
-        zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport_h(1:nb_type_class,jclass)
-     ENDDO
- 
-     !write volume transport per class
-     IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
-        z_hr_output(ksec,hr,1)=-(zsumclasses(1)+zsumclasses(2))
-     ELSE
-        z_hr_output(ksec,hr,1)= (zsumclasses(1)+zsumclasses(2))
-     ENDIF
-
-     DO jclass=1,MAX(1,sec%nb_class-1)
-        IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
-           z_hr_output(ksec,hr,jclass+1)=-(sec%transport_h(1,jclass)+sec%transport_h(2,jclass))
-        ELSE
-           z_hr_output(ksec,hr,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass))
-        ENDIF
-     ENDDO
-
-     IF ( hr .eq. 48._wp ) THEN
-        WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,'   Transect:',ksec-1,'   No. of layers:',sec%nb_class-1
-        DO jhr=25,48
-           WRITE(numdct_NOOS_h,'(11F12.1)')  z_hr_output(ksec,jhr,1), (z_hr_output(ksec,jhr,jclass+1), jclass=1,MAX(1,10) )
-        ENDDO
-     ENDIF
-
-     CALL wrk_dealloc(nb_type_class , zsumclasses )
-
-  END SUBROUTINE dia_dct_wri_NOOS_h
-
   SUBROUTINE dia_dct_wri(kt,ksec,sec)
      !!-------------------------------------------------------------
@@ -1810,11 +1092,11 @@
            WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope,  &
                               jclass,classe,zbnd1,zbnd2,&
-                              sec%transport(7,jclass)*1.e-15,sec%transport(8,jclass)*1.e-15, &
-                              ( sec%transport(7,jclass)+sec%transport(8,jclass) )*1.e-15
+                              sec%transport(3,jclass)*1.e-15,sec%transport(4,jclass)*1.e-15, &
+                              ( sec%transport(3,jclass)+sec%transport(4,jclass) )*1.e-15
            !write salt transport per class
            WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope,  &
                               jclass,classe,zbnd1,zbnd2,&
-                              sec%transport(9,jclass)*1.e-9,sec%transport(10,jclass)*1.e-9,&
-                              (sec%transport(9,jclass)+sec%transport(10,jclass))*1.e-9
+                              sec%transport(5,jclass)*1.e-9,sec%transport(6,jclass)*1.e-9,&
+                              (sec%transport(5,jclass)+sec%transport(6,jclass))*1.e-9
         ENDIF
 
@@ -1835,11 +1117,11 @@
         WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, &
                            jclass,"total",zbnd1,zbnd2,&
-                           zsumclasses(7)*1.e-15,zsumclasses(8)*1.e-15,&
-                           (zsumclasses(7)+zsumclasses(8) )*1.e-15
+                           zsumclasses(3)*1.e-15,zsumclasses(4)*1.e-15,&
+                           (zsumclasses(3)+zsumclasses(4) )*1.e-15
         !write total salt transport
         WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, &
                            jclass,"total",zbnd1,zbnd2,&
-                           zsumclasses(9)*1.e-9,zsumclasses(10)*1.e-9,&
-                           (zsumclasses(9)+zsumclasses(10))*1.e-9
+                           zsumclasses(5)*1.e-9,zsumclasses(6)*1.e-9,&
+                           (zsumclasses(5)+zsumclasses(6))*1.e-9
      ENDIF
 
@@ -1849,11 +1131,11 @@
         WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
                               jclass,"ice_vol",zbnd1,zbnd2,&
-                              sec%transport(11,1),sec%transport(12,1),&
-                              sec%transport(11,1)+sec%transport(12,1)
+                              sec%transport(7,1),sec%transport(8,1),&
+                              sec%transport(7,1)+sec%transport(8,1)
         !write total ice surface transport
         WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
                               jclass,"ice_surf",zbnd1,zbnd2,&
-                              sec%transport(13,1),sec%transport(14,1), &
-                              sec%transport(13,1)+sec%transport(14,1) 
+                              sec%transport(9,1),sec%transport(10,1), &
+                              sec%transport(9,1)+sec%transport(10,1) 
      ENDIF
                                               
@@ -1864,5 +1146,5 @@
   END SUBROUTINE dia_dct_wri
 
-   PURE  FUNCTION interp(ki, kj, kk, cd_point,var) 
+  FUNCTION interp(ki, kj, kk, cd_point, ptab)
   !!----------------------------------------------------------------------
   !!
@@ -1926,6 +1208,6 @@
   !*arguments
   INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point
-  INTEGER, INTENT(IN)                          :: var   !  which variable
   CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V)
+  REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab         ! variable to compute at (ki, kj, kk )
   REAL(wp)                                     :: interp       ! interpolated variable 
 
@@ -1938,6 +1220,4 @@
   !!----------------------------------------------------------------------
 
- 
-
   IF( cd_point=='U' )THEN 
      ii1 = ki    ; ij1 = kj 
@@ -1970,10 +1250,6 @@
   
      ! result
-           SELECT CASE( var )
-              CASE(0)  ;    interp = zmsk * ( zwgt2 *  tsn(ii1,ij1,kk,jp_tem) + zwgt1 *  tsn(ii1,ij1,kk,jp_tem) ) / ( zwgt2 + zwgt1 )
-              CASE(1)  ;    interp = zmsk * ( zwgt2 *  tsn(ii1,ij1,kk,jp_sal) + zwgt1 *  tsn(ii1,ij1,kk,jp_sal) ) / ( zwgt2 + zwgt1 )
-              CASE(2)  ;    interp = zmsk * ( zwgt2 *  rhop(ii1,ij1,kk) + zwgt1 *  rhop(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )
-              CASE(3)  ;    interp = zmsk * ( zwgt2 *  (rhd(ii1,ij1,kk)*rau0+rau0) + zwgt1 *  (rhd(ii1,ij1,kk)*rau0+rau0) ) / ( zwgt2 + zwgt1 )
-           END SELECT
+     interp = zmsk * ( zwgt2 *  ptab(ii1,ij1,kk) + zwgt1 *  ptab(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )   
+
 
   ELSE       ! full step or partial step case 
@@ -1997,51 +1273,20 @@
         IF( ze3t >= 0. )THEN 
            ! zbis
-           SELECT CASE( var )
-           CASE(0)  
-                     zbis   =  tsn(ii2,ij2,kk,jp_tem) + zwgt1 *  (tsn(ii2,ij2,kk-1,jp_tem)-tsn(ii2,ij2,kk,jp_tem)   )
-                     interp =  zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * zbis )/( zet1 + zet2 )
-           CASE(1)  
-                     zbis   =  tsn(ii2,ij2,kk,jp_sal) + zwgt1 *  (tsn(ii2,ij2,kk-1,jp_sal)-tsn(ii2,ij2,kk,jp_sal)   )
-                     interp =  zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * zbis )/( zet1 + zet2 )
-           CASE(2)  
-                     zbis   =  rhop(ii2,ij2,kk) + zwgt1 *  (rhop(ii2,ij2,kk-1)-rhop(ii2,ij2,kk)   )
-                     interp =  zmsk * ( zet2 * rhop(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )
-           CASE(3)  
-                     zbis   =  (rhd(ii2,ij2,kk)*rau0+rau0) + zwgt1 *  ( (rhd(ii2,ij2,kk-1)*rau0+rau0)-(rhd(ii2,ij2,kk)*rau0+rau0)   )
-                     interp =  zmsk * ( zet2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zet1 * zbis )/( zet1 + zet2 )
-           END SELECT
+           zbis = ptab(ii2,ij2,kk) + zwgt1 * ( ptab(ii2,ij2,kk-1) - ptab(ii2,ij2,kk) ) 
            ! result
+            interp = zmsk * ( zet2 * ptab(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )
         ELSE
            ! zbis
-           SELECT CASE( var )
-           CASE(0)  
-                 zbis   = tsn(ii1,ij1,kk,jp_tem) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_tem) - tsn(ii1,ij2,kk,jp_tem) )
-                 interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 )
-           CASE(1)  
-                 zbis   = tsn(ii1,ij1,kk,jp_sal) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_sal) - tsn(ii1,ij2,kk,jp_sal) )
-                 interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 )
-           CASE(2)  
-                 zbis   = rhop(ii1,ij1,kk) + zwgt2 * ( rhop(ii1,ij1,kk-1) - rhop(ii1,ij2,kk) )
-                 interp = zmsk * ( zet2 * zbis + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 )
-           CASE(3)  
-                 zbis   = (rhd(ii1,ij1,kk)*rau0+rau0) + zwgt2 * ( (rhd(ii1,ij1,kk-1)*rau0+rau0) - (rhd(ii1,ij2,kk)*rau0+rau0) )
-                 interp = zmsk * ( zet2 * zbis + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 )
-           END SELECT
+           zbis = ptab(ii1,ij1,kk) + zwgt2 * ( ptab(ii1,ij1,kk-1) - ptab(ii1,ij2,kk) )
+           ! result
+           interp = zmsk * ( zet2 * zbis + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )
         ENDIF    
 
      ELSE
-        SELECT CASE( var )
-        CASE(0)  
-           interp = zmsk * (  zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 )
-        CASE(1)  
-           interp = zmsk * (  zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 )
-        CASE(2)  
-           interp = zmsk * (  zet2 * rhop(ii1,ij1,kk) + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 )
-        CASE(3)  
-           interp = zmsk * (  zet2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 )
-        END SELECT
+        interp = zmsk * (  zet2 * ptab(ii1,ij1,kk) + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )
      ENDIF
 
   ENDIF
+
 
   END FUNCTION interp
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 10251)
@@ -196,7 +196,9 @@
                   DO ji = 1,jpi
                      ! Elevation
-                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*tmask_i(ji,jj)        
-                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*umask_i(ji,jj)
-                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*vmask_i(ji,jj)
+                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask_i(ji,jj)        
+#if defined key_dynspg_ts
+                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask_i(ji,jj)
+                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask_i(ji,jj)
+#endif
                   END DO
                END DO
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharmana.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaharmana.F90	(revision 10250)
+++ 	(revision )
@@ -1,667 +1,0 @@
-MODULE harmonic_analysis
-   !!======================================================================
-   !!                       ***  MODULE  example  ***
-   !! Ocean physics:  On line harmonic analyser
-   !!                 
-   !!=====================================================================
-
-#if defined key_harm_ana
-   !!----------------------------------------------------------------------
-   !!   'key_harm_ana'  :                Calculate harmonic analysis
-   !!----------------------------------------------------------------------
-   !!   harm_ana        :
-   !!   harm_ana_init   :
-   !!----------------------------------------------------------------------
-
-   USE oce             ! ocean dynamics and tracers 
-   USE dom_oce         ! ocean space and time domain
-   USE iom
-   USE in_out_manager  ! I/O units
-   USE phycst          ! physical constants
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE bdy_par         ! Unstructured boundary parameters
-   USE bdy_oce         ! ocean open boundary conditions
-   USE bdytides        ! tidal bdy forcing
-   USE daymod          ! calendar
-   USE tideini
-   USE restart
-   USE ioipsl, ONLY : ju2ymds    ! for calendar
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! *  Routine accessibility
-   PUBLIC harm_ana    ! routine called in step.F90 module
-
-   !! * Module variables
-   INTEGER, PARAMETER ::  nharm_max  =   jptides_max ! max number of harmonics to be analysed 
-   INTEGER, PARAMETER ::  nhm_max    =   2*jptides_max+1 
-   INTEGER, PARAMETER ::  nvab       = 2 ! number of 3D variables
-   INTEGER            ::  nharm
-   INTEGER            ::  nhm 
-   INTEGER ::                 & !!! ** toto namelist (namtoto) **
-      nflag  =  1                ! default value of nflag 
-   REAL(wp), DIMENSION(nharm_max) ::                & 
-      om_tide                     ! tidal frequencies ( rads/sec)
-   REAL(wp), ALLOCATABLE,SAVE,DIMENSION(:)   ::                & 
-      bzz,c,x    ! work arrays
-   REAL(wp) :: cca,ssa,zm,bt
-   REAL(wp) :: ccau,ccav,ssau,ssav
-   REAL(wp), PUBLIC, ALLOCATABLE,DIMENSION(:) :: anau, anav, anaf   ! nodel/phase corrections used by diaharmana
-!
-   REAL(wp), ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::   &
-      bssh,bubar,bvbar        ! work array for ssh anaylsis
-   REAL(wp), ALLOCATABLE,SAVE, DIMENSION(:,:,:) ::   &
-      cosampz, cosampu,cosampv,      &
-      sinampz, sinampu,sinampv
-   REAL(WP), ALLOCATABLE,SAVE,DIMENSION(:,:) :: cc,a
-!
-   REAL(wp), ALLOCATABLE,SAVE,DIMENSION(:,:) ::   &
-      gout,hout        ! arrays for output
-   REAL(wp), ALLOCATABLE,SAVE,DIMENSION(:,:) ::   &
-      huout,hvout,guout,gvout        ! arrays for output
-   REAL(wp), PUBLIC ::   fjulday_startharm       !: Julian Day since start of harmonic analysis
-
-   !! * Substitutions
-
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! or LIM 2.0 , UCL-LOCEAN-IPSL (2005)
-   !! or  TOP 1.0 , LOCEAN-IPSL (2005)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/module_example,v 1.3 2005/03/27 18:34:47 opalod Exp $ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE harm_ana( kt )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE harm_ana  ***
-      !!
-      !! ** Purpose :   Harmonic analyser
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  : - first action (share memory array/varible modified
-      !!                in this routine
-      !!              - second action .....
-      !!              - .....
-      !!
-      !! References :
-      !!   Give references if exist otherwise suppress these lines
-      !!
-      !! History :
-      !!   9.0  !  03-08  (Autor Names)  Original code
-      !!        !  02-08  (Author names)  brief description of modifications
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      
-      !! * arguments
-      INTEGER, INTENT( in  ) ::   &  
-         kt                          ! describe it!!!
-
-      !! * local declarations
-      INTEGER ::   ji, jj, jk,  &        ! dummy loop arguments
-                   ih,i1,i2,iv,jgrid
-
-
-      !!--------------------------------------------------------------------
-
-
-
-      IF( kt == nit000  )   CALL harm_ana_init    ! Initialization (first time-step only)
-
-! this bit done every time step
-        !nharm=ncpt_anal
-        nharm=nb_harmo
-        nhm=2*nb_harmo+1
-       
-        c(1)=1.0
-
-        do ih=1,nb_harmo
-             c(2*ih)=    cos((fjulday-fjulday_startharm)*86400._wp*om_tide(ih)  )
-             c(2*ih+1)=  sin((fjulday-fjulday_startharm)*86400._wp*om_tide(ih)  )
-        enddo
-
-
-         do ji=1,jpi
-          do jj=1,jpj
-            do ih=1,nhm
-            bssh (ih,ji,jj)=bssh (ih,ji,jj)+c(ih)*sshn(ji,jj)
-            bubar(ih,ji,jj)=bubar(ih,ji,jj)+c(ih)*un_b(ji,jj)
-            bvbar(ih,ji,jj)=bvbar(ih,ji,jj)+c(ih)*vn_b(ji,jj)
-            enddo
-          enddo
-        enddo
-!  
-!        IF(lwp) WRITE(666,'(4E15.5)') adatrj*86400._wp, sshn(10,10),bssh(2,10,10),bssh(3,10,10)
-!
-         do i1=1,nhm
-           do i2=1,nhm
-             cc(i1,i2)=cc(i1,i2)+c(i1)*c(i2)
-            enddo
-         enddo
-!
-! At End of run
-
-      IF (kt ==  nitend  ) then
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'harm_ana : harmonic analysis of tides at end of run'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
-      CALL harm_rst_write(kt)     ! Dump out data for a restarted run
-
-
-      if(ln_harm_ana_compute) then
-               WRITE(numout,*) "Computing harmonics at last step"
-!
-        cosampu=0.0_wp
-        sinampu=0.0_wp
-        cosampv=0.0_wp
-        sinampv=0.0_wp
-        cosampz=0.0_wp
-        sinampz=0.0_wp
-!
-     do jgrid=1,3 ! elevation, Ubar,Vbar
-        do ji=1,jpi
-            do jj=1,jpj
-               bt=1.0
-               do ih=1,nhm
-                   if(jgrid .eq. 1) then
-                     bzz(ih)=bssh(ih,ji,jj)
-                   endif
-                   if(jgrid .eq. 2) then
-                     bzz(ih)=bubar(ih,ji,jj)
-                   endif
-                   if(jgrid .eq. 3) then
-                     bzz(ih)=bvbar(ih,ji,jj)
-                   endif
-                   bt=bt*bzz(ih)
-               enddo
-
-               do i1=1,nhm
-                   do i2=1,nhm
-                       a(i1,i2)=cc(i1,i2)
-                   enddo
-               enddo
-!	now do gaussian elimination of the system
-!	a * x = b
-! 	the matrix x is (a0,a1,b1,a2,b2 ...)
-!	the matrix a and rhs b solved here for x
-              x=0.0d0
-              if(bt.ne.0.) then
-                  if(lwp .and. ji == 10 .and. ji == 10) then
-              endif
-              call gelim(a,bzz,x,nhm)
-
-              do ih=1,nb_harmo
-                if(jgrid .eq. 1) then
-                   cosampz(ih,ji,jj)=x(ih*2)
-                   sinampz(ih,ji,jj)=x(ih*2+1)
-                endif
-                if(jgrid .eq. 2) then
-                   cosampu(ih,ji,jj)=x(ih*2)
-                   sinampu(ih,ji,jj)=x(ih*2+1)
-                endif
-                if(jgrid .eq. 3) then
-                   cosampv(ih,ji,jj)=x(ih*2)
-                   sinampv(ih,ji,jj)=x(ih*2+1)
-                endif
-              enddo
-                if(jgrid .eq. 1) then
-                  cosampz(0,ji,jj)=x(1)
-                  sinampz(0,ji,jj)=0.0_wp
-                endif
-                if(jgrid .eq. 2) then
-                  cosampu(0,ji,jj)=x(1)
-                  sinampu(0,ji,jj)=0.0_wp
-                endif
-                if(jgrid .eq. 3) then
-                  cosampv(0,ji,jj)=x(1)
-                  sinampv(0,ji,jj)=0.0_wp
-                endif
-              endif
-           enddo
-        enddo
-      enddo ! jgrid
-!
-!
-        CALL harm_ana_out     ! output analysis (last time step)
-     ELSE ! ln_harmana_compute 
-         WRITE(numout,*) "Skipping Computing harmonics at last step"
-     ENDIF
-       
-    ENDIF
-   END SUBROUTINE harm_ana
-
-   SUBROUTINE harm_ana_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE harm_ana_init  ***
-      !!                   
-      !! ** Purpose :   initialization of ....
-      !!
-      !! ** Method  :   blah blah blah ...
-      !!
-      !! ** input   :   Namlist namexa
-      !!
-      !! ** Action  :   ...  
-      !!
-      !! history :
-      !!   9.0  !  03-08  (Autor Names)  Original code
-      !!----------------------------------------------------------------------
-      !! * local declarations
-      INTEGER ::   ji, jj, jk, jit,ih   ! dummy loop indices
-
-      !!----------------------------------------------------------------------
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'harm_init : initialization of harmonic analysis of tides'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
-     ! DO ALLOCATIONS
-
-      ALLOCATE( bubar(nb_harmo*2+1,jpi,jpj) )
-      ALLOCATE( bvbar(nb_harmo*2+1,jpi,jpj) )
-      ALLOCATE( bssh (nb_harmo*2+1,jpi,jpj) )
-
-      ALLOCATE( cosampz(0:nb_harmo*2+1,jpi,jpj))
-      ALLOCATE( cosampu(0:nb_harmo*2+1,jpi,jpj))
-      ALLOCATE( cosampv(0:nb_harmo*2+1,jpi,jpj))
-
-      ALLOCATE( sinampz(0:nb_harmo*2+1,jpi,jpj))
-      ALLOCATE( sinampu(0:nb_harmo*2+1,jpi,jpj))
-      ALLOCATE( sinampv(0:nb_harmo*2+1,jpi,jpj))
-
-      ALLOCATE( cc(nb_harmo*2+1,nb_harmo*2+1) )
-
-      ALLOCATE( a(nb_harmo*2+1,nb_harmo*2+1) )
-
-      ALLOCATE( anau(nb_harmo) )
-      ALLOCATE( anav(nb_harmo) )
-      ALLOCATE( anaf(nb_harmo) )
-
-      ALLOCATE( bzz(nb_harmo*2+1) )
-      ALLOCATE( x(nb_harmo*2+1) )
-      ALLOCATE( c(nb_harmo*2+1) )
-
-      ALLOCATE( gout(jpi,jpj))
-      ALLOCATE( hout(jpi,jpj))
-
-      ALLOCATE( guout(jpi,jpj))
-      ALLOCATE( huout(jpi,jpj))
-
-      ALLOCATE( gvout(jpi,jpj))
-      ALLOCATE( hvout(jpi,jpj))
-
-        ! END ALLOCATE 
-
-                 do ih=1,nb_harmo
-                  om_tide(ih)= omega_tide(ih) 
-                 enddo
-       if(ln_harmana_read) then
-               WRITE(numout,*) "Reading previous harmonic data from previous run"
-               ! Need to read in  bssh bz, cc anau anav and anaf 
-               call harm_rst_read  ! This reads in from the previous day
-                                   ! Currrently the data in in assci format
-       else
-               WRITE(numout,*) "Starting harmonic analysis from Fresh "
-         bssh(:,:,:)  = 0.0_wp
-         bubar(:,:,:) = 0.0_wp
-         bvbar(:,:,:) = 0.0_wp
-
-         cc=0.0_wp
-
-         anau(:) = 0.0_wp
-         anav(:) = 0.0_wp
-         anaf(:) = 0.0_wp
-         bzz(:) = 0.0_wp
-         x(:) = 0.0_wp
-         c(:) = 0.0_wp
-
-         DO ih = 1, nb_harmo
-            anau(ih) = utide(ih)
-            anav(ih) = v0tide(ih)
-            anaf(ih) = ftide(ih)
-
-         END DO
-         fjulday_startharm=fjulday !Set this at very start and store
-      endif
-
-   END SUBROUTINE harm_ana_init
-!
-   SUBROUTINE gelim (a,b,x,n)
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE harm_ana  ***
-      !!
-      !! ** Purpose :   Guassian elimination
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  : - first action (share memory array/varible modified
-      !!                in this routine
-      !!              - second action .....
-      !!              - .....
-      !!
-      !! References :
-      !!   Give references if exist otherwise suppress these lines
-      !!
-      !! History :
-        implicit none
-!
-        integer  :: n
-   REAL(WP) :: b(nb_harmo*2+1),a(nb_harmo*2+1,nb_harmo*2+1)
-   REAL(WP) :: x(nb_harmo*2+1)
-        INTEGER  :: row,col,prow,pivrow,rrow,ntemp
-   REAL(WP) ::  atemp
-   REAL(WP) ::  pivot
-   REAL(WP) ::  m
-   REAL(WP) ::  tempsol(nb_harmo*2+1)
-
-
-        do row=1,n-1
-           pivrow=row
-           pivot=a(row,n-row+1)
-           do prow=row+1,n
-              if (abs(a(prow,n-row+1)).gt.abs(pivot)  ) then
-                 pivot=a(prow,n-row+1)
-                 pivrow=prow
-              endif
-           enddo
-!	swap row and prow
-           if ( pivrow .ne. row ) then
-              atemp=b(pivrow)
-              b(pivrow)=b(row)
-              b(row)=atemp
-              do col=1,n
-                 atemp=a(pivrow,col)
-                 a(pivrow,col)=a(row,col)
-                 a(row,col)=atemp
-              enddo
-           endif
-
-           do rrow=row+1,n
-              if (a(row,row).ne.0) then
-   
-                 m=-a(rrow,n-row+1)/a(row,n-row+1)
-                 do col=1,n
-                    a(rrow,col)=m*a(row,col)+a(rrow,col)
-                 enddo
-                 b(rrow)=m*b(row)+b(rrow)
-              endif
-           enddo
-        enddo
-!	back substitution now
-
-        x(1)=b(n)/a(n,1)
-        do row=n-1,1,-1
-           x(n-row+1)=b(row)
-           do col=1,(n-row)
-              x(n-row+1)=(x(n-row+1)-a(row,col)*x(col)) 
-           enddo
-
-           x(n-row+1)=(x(n-row+1)/a(row,(n-row)+1))
-        enddo
-
-        return
-        END SUBROUTINE gelim
-
-   SUBROUTINE harm_ana_out
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE harm_ana_init  ***
-      !!                   
-      !! ** Purpose :   initialization of ....
-      !!
-      !! ** Method  :   blah blah blah ...
-      !!
-      !! ** input   :   Namlist namexa
-      !!
-      !! ** Action  :   ...  
-      !!
-      !! history :
-      !!   9.0  !  03-08  (Autor Names)  Original code
-      !!----------------------------------------------------------------------
-        USE dianam          ! build name of file (routine)
- 
-      !! * local declarations
-      INTEGER ::   ji, jj, jk, jgrid,jit, ih, jjk   ! dummy loop indices
-      INTEGER :: nh_T
-      INTEGER :: nid_harm
-      CHARACTER (len=40) ::           &
-         clhstnamt, clop1, clop2          ! temporary names 
-      CHARACTER (len=40) ::           &
-         clhstnamu, clhstnamv   ! temporary names 
-      REAL(wp) ::   &
-         zsto1, zsto2, zout, zmax,            &  ! temporary scalars
-         zjulian, zdt, zmdi  
-         
-        do jgrid=1,3
-          do ih=1,nb_harmo
-            hout = 0.0
-            gout = 0.0
-            do jj=1,nlcj
-                do ji=1,nlci
-                    if(jgrid .eq. 1) then ! SSH 
-                       cca=cosampz(ih,ji,jj)
-                       ssa=sinampz(ih,ji,jj)
-                    endif
-                    if(jgrid .eq. 2) then ! UBAR
-                       cca=cosampu(ih,ji,jj)
-                       ssa=sinampu(ih,ji,jj)
-                    endif
-                    if(jgrid .eq. 3) then ! VBAR
-                       cca=cosampv(ih,ji,jj)
-                       ssa=sinampv(ih,ji,jj)
-                    endif
-
-                    hout(ji,jj)=sqrt(cca**2+ssa**2)
-        
-                    if (cca.ne.0.0) then
-                         gout(ji,jj)=(180.0/rpi)*atan(ssa/cca)
-                    else
-                        if (ssa.ne.0.0) then
-                            if (ssa.gt. 0.0) then
-                                 gout(ji,jj)=90.0
-                            else
-                                 gout(ji,jj)=270.0
-                            endif
-                        else
-                            gout(ji,jj)=0.0
-                        endif
-                    endif
-
-                    if (gout(ji,jj).lt.0) then
-                        gout(ji,jj)=gout(ji,jj)+180.0
-                    endif
-                    if (ssa.lt.0) then
-                        gout(ji,jj)=gout(ji,jj)+180.0
-                    endif
-                    
-                    if (hout(ji,jj).ne.0) then
-                        hout(ji,jj)=hout(ji,jj)/anaf(ih)
-                    endif
-                    if (gout(ji,jj).ne.0) then
-                                                !Convert Rad to degree and take
-                                                !modulus
-                         gout(ji,jj)=gout(ji,jj)+MOD( (anau(ih)+anav(ih))/rad , 360.0)
-                        if (gout(ji,jj).gt.360.0) then
-                            gout(ji,jj)=gout(ji,jj)-360.0
-                        else if (gout(ji,jj).lt.0) then
-                            gout(ji,jj)=gout(ji,jj)+360.0
-                        endif
-                    endif
-                enddo
-            enddo
-!NETCDF OUTPUT
-            if(jgrid==1) then
-             WRITE(numout,*) TRIM(Wave(ntide(ih))%cname_tide)//'amp'
-             WRITE(numout,*) TRIM(Wave(ntide(ih))%cname_tide)//'phase'
-             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'amp', hout(:,:) )
-             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'phase', gout(:,:) )
-            endif
-            if(jgrid==2) then
-             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'amp_u', hout(:,:) )
-             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'phase_u', gout(:,:) )
-            endif
-            if(jgrid==3) then
-             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'amp_v', hout(:,:) )
-             CALL iom_put( TRIM(Wave(ntide(ih))%cname_tide)//'phase_v', gout(:,:) )
-            endif
-          enddo
-        enddo
- 
-!
-   END SUBROUTINE harm_ana_out
-
-   SUBROUTINE harm_rst_write(kt)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE harm_ana_init  ***
-      !!                   
-      !! ** Purpose :  To write out cummulated Tidal Harmomnic data to file for
-      !!               restarting
-      !!
-      !! ** Method  :   restart files will be dated by default
-      !!
-      !! ** input   :   
-      !!
-      !! ** Action  :   ...  
-      !!
-      !! history :
-      !!   0.0  !  01-16  (Enda O'Dea)  Original code
-      !! ASSUMES  dated file for rose  , can change later to be more generic
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step
-      INTEGER             ::   iyear, imonth, iday,ih
-      REAL (wp)           ::   zsec
-      !!
-      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
-      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
-      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file
-      CHARACTER(LEN=250)  ::   clfinal   ! full name
-
-      CALL ju2ymds( fjulday , iyear, imonth, iday, zsec)
-
-      WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
-      ! create the file
-      clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart_harm_ana"
-      clpath = TRIM(cn_ocerst_outdir)
-      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
-      WRITE(numout,*) 'Open tidal harmonics restart file for writing: ',TRIM(clpath)//clname
-
-
-
-
-!!      clhstnam=TRIM(cexper)//'.restart_harm_ana'
-      ! Open a file to write the data into
-         write (clfinal,'(a,''_'',i4.4)') trim(clpath)//trim(clname),nproc
-         open(66,file=TRIM(clfinal))
-         write(66,'(1e20.9)') cc
-         !These Three which contain the most data can be moved to a regular
-         !restart file
-
-            CALL iom_rstput( kt, nitrst, numrow, 'Mean_bssh'     , bssh(1,:,:)       )
-            CALL iom_rstput( kt, nitrst, numrow, 'Mean_bubar'    , bubar(1,:,:)       )
-            CALL iom_rstput( kt, nitrst, numrow, 'Mean_bvbar'    , bvbar(1,:,:)       )
-         do ih=1,nb_harmo
-            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bssh_cos'    , bssh (ih*2  , : , : )     )
-            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bssh_sin'    , bssh (ih*2+1, : , : )     )
-
-            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bubar_cos'   , bubar(ih*2  , : , : )    )
-            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bubar_sin'   , bubar(ih*2+1, : , : )    )
-
-            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bvbar_cos'   , bvbar(ih*2  , : , : )    )
-            CALL iom_rstput( kt, nitrst, numrow, TRIM(Wave(ntide(ih))%cname_tide)//'bvbar_sin'   , bvbar(ih*2+1, : , : )    )
-         enddo
-
-         write(66,'(1e20.9)') anau
-         write(66,'(1e20.9)') anav
-         write(66,'(1e20.9)') anaf
-         write(66,'(1e25.20)') fjulday_startharm
-         close(66)
- 
-   END SUBROUTINE harm_rst_write
-
-   SUBROUTINE harm_rst_read
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE harm_ana_init  ***
-      !!                   
-      !! ** Purpose :  To read in  cummulated Tidal Harmomnic data to file for
-      !!               restarting
-      !!
-      !! ** Method  :   
-      !!
-      !! ** input   :   
-      !!
-      !! ** Action  :   ...  
-      !!
-      !! history :
-      !!   0.0  !  01-16  (Enda O'Dea)  Original code
-      !! ASSUMES  dated file for rose  , can change later to be more generic
-      !!----------------------------------------------------------------------
-      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
-      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file
-      CHARACTER(LEN=250)  ::   clfinal   ! full name
-      INTEGER             ::   ih
-
-      ! create the file
-      clname = "restart_harm_ana"
-      clpath = TRIM(cn_ocerst_indir)
-      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
-      WRITE(numout,*) 'Open tidal harmonics restart file for reading: ',TRIM(clpath)//clname
-
-
-
-
-!!      clhstnam=TRIM(cexper)//'.restart_harm_ana'
-      ! Open a file to read the data ifrom
-         write (clfinal,'(a,''_'',i4.4)') trim(clpath)//trim(clname),nproc
-         open(66,file=TRIM(clfinal),status='old')
-         read(66,'(1e20.9)') cc
-!2D regular fields can be read from normal restart this saves space and handy to
-!view in netcdf format also.
-         CALL iom_get( numror,jpdom_autoglo, 'Mean_bssh'     , bssh(1,:,:)       )
-         CALL iom_get( numror,jpdom_autoglo, 'Mean_bubar'    , bubar(1,:,:)       )
-         CALL iom_get( numror,jpdom_autoglo, 'Mean_bvbar'    , bvbar(1,:,:)       )
-          
-         do ih=1,nb_harmo
-
-            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bssh_cos'    , bssh (ih*2  , : , : )     )
-            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bssh_sin'    , bssh (ih*2+1, : , : )     )
-
-            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bubar_cos'   , bubar(ih*2  , : , : )    )
-            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bubar_sin'   , bubar(ih*2+1, : , : )    )
-
-            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bvbar_cos'   , bvbar(ih*2  , : , : )    )
-            CALL iom_get(   numror,jpdom_autoglo, TRIM(Wave(ntide(ih))%cname_tide)//'bvbar_sin'   , bvbar(ih*2+1, : , : )    )
-         enddo
-         read(66,'(1e20.9)') anau
-         read(66,'(1e20.9)') anav
-         read(66,'(1e20.9)') anaf
-         read(66,'(1e25.20)') fjulday_startharm
-      WRITE(numout,*) 'Checking anaf is correct'
-      WRITE(numout,*) anaf
-      WRITE(numout,*) '---end of anaf checking----'
-
-         close(66)
-
-   END SUBROUTINE harm_rst_read
-
-   !!======================================================================
-#else
-!!---------------------------------------------------------------------------------
-!!   Dummy module                                   NO harmonic Analysis
-!!---------------------------------------------------------------------------------
-        CONTAINS
-           SUBROUTINE harm_rst_write(kt)     ! Dummy routine
-           END SUBROUTINE harm_rst_write
-           SUBROUTINE harm_rst_read    ! Dummy routine
-           END SUBROUTINE harm_rst_read
-           SUBROUTINE harm_ana_out      ! Dummy routine
-           END SUBROUTINE harm_ana_out
-           SUBROUTINE harm_ana_init
-           END SUBROUTINE harm_ana_init
-           SUBROUTINE harm_ana( kt )
-           END SUBROUTINE harm_ana
-           SUBROUTINE gelim (a,b,x,n)
-           END SUBROUTINE gelim
-           
-#endif
-
-END MODULE harmonic_analysis
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 10251)
@@ -93,5 +93,5 @@
       ! 1 - Trends due to forcing !
       ! ------------------------- !
-      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
+      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
       z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) )                               ! heat fluxes
       z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) )                               ! salt fluxes
@@ -101,6 +101,7 @@
       ! Add ice shelf heat & salt input
       IF( nn_isf .GE. 1 )  THEN
-          z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) )
-          z_frc_trd_s = z_frc_trd_s + glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) )
+          z_frc_trd_t = z_frc_trd_t &
+              &   + glob_sum( ( risf_tsc(:,:,jp_tem) - rdivisf * fwfisf(:,:) * (-1.9) * r1_rau0 ) * surf(:,:) )
+          z_frc_trd_s = z_frc_trd_s + (1.0_wp - rdivisf) * glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) )
       ENDIF
 
@@ -199,4 +200,5 @@
 !      ENDIF
 !!gm end
+
 
       IF( lk_vvl ) THEN
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diainsitutem.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diainsitutem.F90	(revision 10250)
+++ 	(revision )
@@ -1,124 +1,0 @@
-MODULE diainsitutem
-   !!======================================================================
-   !!                       ***  MODULE  diaharm  ***
-   !! Harmonic analysis of tidal constituents
-   !!======================================================================
-   !! Initial version: D. Acreman June 2006 Original Code
-   !! History :  3.6  !  2014  (E O'Dea) for 3.6 25hour mean output
-   !!----------------------------------------------------------------------
-
-  USE dom_oce  ! ocean space and time domain
-  USE oce,            ONLY: tsn
-  USE par_oce,        ONLY: jpi, jpj, jpk, jpkm1
-  USE lbclnk,         ONLY: lbc_lnk
-  USE lib_mpp         ! MPP library
-
-  IMPLICIT NONE
-  PRIVATE
-
-  PUBLIC theta2t
-
-  !! * Accessibility
-  PUBLIC insitu_tem_alloc          ! routines called by step.F90
-
-  REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: rinsitu_t
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-
-CONTAINS
-
-   REAL FUNCTION insitu_tem_alloc()
-      !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(2) :: ierr
-      !!----------------------------------------------------------------------
-      !
-      ierr = 0
-      !
-      ALLOCATE( rinsitu_t(jpi,jpj,jpk), STAT=ierr(1) )
-         !
-      insitu_tem_alloc = MAXVAL(ierr)
-      IF( lk_mpp )   CALL mpp_sum( insitu_tem_alloc )
-      !
-  END FUNCTION insitu_tem_alloc
-
-!-----------------------------------------------------------------------------------
-!
-! Calculate the insitu temperature by integrating the adiabatic lapse rate from zero 
-! to pressure at depth of tracer level. Based on UM subroutine POTTEM and function ATG
-!
-! Initial version: D. Acreman June 2006
-!
-!-----------------------------------------------------------------------------------
-
-  SUBROUTINE theta2t()
-
-    INTEGER, PARAMETER :: inum_steps=10                ! number of steps in integration
-    INTEGER            :: jstep                        ! iteration counter
-    INTEGER            :: ji, jj, jk                  ! loop indices
-    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zP            ! pressure (decibars)
-    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zT            ! temperature at pressure p
-    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTB           ! temperature at p-dp
-    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zTA           ! temperature at p+dp
-    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zDP           ! pressure step
-    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zSS           ! salinity(PSU) - 35.0
-    REAL(wp), DIMENSION(jpi,jpj,jpk) :: zLAPSE        ! adiabatic lapse rate
-
-!CDIR IEXPAND (ATG)
-
-! Set the pressure interval for the integration. The integration is carried out from 
-! zero (pressure at the surface) to the pressure at the depth of the tracer point. The
-! pressure in decibars is represented by the depth in metres. Pressures are "Oceanographic"
-! pressures equal to absolute pressure minus one atmosphere
-     zDP(:,:,:) = 0.0
-     DO jk = 1, jpkm1
-        DO jj = 1, jpj
-           DO ji = 1, jpi
-              ! These loops expanded for case where fsdept may be 1D
-              zDP(ji,jj,jk) = fsdept(ji,jj,jk) / real(inum_steps)
-           END DO
-        END DO
-     END DO
-
-! Salinity at each point
-     zSS(:,:,:)      = tsn(:,:,:,jp_sal) - 35.0 
-
-! Set initial values of temperature and pressure. zT is the temperature at pressure zP, 
-! zTB is the temperature at pressure zP-zdP and zTA is the temperature at pressure zP+zdP
-     zT(:,:,:)  = tsn(:,:,:,jp_tem)
-     zP(:,:,:)  = 0.0         ! Pressure at surface
-     CALL ATG(zP, zT, zSS, zLAPSE)
-     zTB(:,:,:) = zT(:,:,:)  - zLAPSE(:,:,:) * zDP(:,:,:)
-
-     interation: DO jstep=1, inum_steps
-        ! Calculate lapse rate (dT/dP) and hence TA
-        CALL ATG(zP, zT, zSS, zLAPSE)
-        zTA(:,:,:) = zTB(:,:,:) + 2.0 * zLAPSE(:,:,:) * zDP(:,:,:)
-        ! Have calculated TB, T and TA for this pressure, now advance solution by dP
-        zP(:,:,:)  = zP(:,:,:)  + zDP
-        zTB(:,:,:) = zT(:,:,:)
-        zT(:,:,:)  = zTA(:,:,:)
-
-     END DO interation
-
-     rinsitu_t(:,:,:) = zT(:,:,:) * tmask(:,:,:)
-     CALL lbc_lnk( rinsitu_t,  'T', 1.0)
-
-   END SUBROUTINE theta2t
-
-   SUBROUTINE ATG(P,T,DS,zLAPSE)
-
-     REAL, INTENT(IN   ) :: P(jpi,jpj,jpk)        ! PRESSURE (DECIBARS)
-     REAL, INTENT(IN   ) :: T(jpi,jpj,jpk)        ! TEMPERATURE (DEG C)
-     REAL, INTENT(IN   ) :: DS(jpi,jpj,jpk)       ! SALINITY (PSU) -35.0
-     REAL, INTENT(  OUT) :: zLAPSE(jpi,jpj,jpk)   ! LAPSE RATE
-
-       zLAPSE = ((( -2.1687E-16*T+1.8676E-14)*T-4.6206E-13)*P &
-           + ((2.7759E-12*T-1.1351E-10)*DS+((-5.4481E-14*T    &
-           + 8.733E-12)*T-6.7795E-10)*T+1.8741E-8))*P         &
-           + (-4.2393E-8*T+1.8932E-6)*DS                      &
-           + ((6.6228E-10*T-6.836E-8)*T+8.5258E-6)*T+3.5803E-5 
-
-   END SUBROUTINE ATG
-
-END MODULE diainsitutem
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90	(revision 10250)
+++ 	(revision )
@@ -1,182 +1,0 @@
-MODULE diaopfoam
-   !!======================================================================
-   !!                       ***  MODULE  diaopfoam  ***
-   !! Output stream for operational use
-   !!======================================================================
-   !! History :  3.6  !  2016  (P Sykes)  Original code
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   USE diainsitutem, ONLY: rinsitu_t, theta2t
-   USE in_out_manager  ! I/O units
-   USE iom             ! I/0 library
-   USE wrk_nemo        ! working arrays
-   USE diatmb
-   USE diurnal_bulk
-   USE cool_skin
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   LOGICAL , PUBLIC ::   ln_diaopfoam     !: Diaopfoam output 
-   PUBLIC   dia_diaopfoam_init            ! routine called by nemogcm.F90
-   PUBLIC   dia_diaopfoam                 ! routine called by diawri.F90
-   PUBLIC   calc_max_cur                  ! routine called by diaopfoam.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dia_diaopfoam_init
-      !!---------------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_wri_diaop_init  ***
-      !!     
-      !! ** Purpose: Initialization of diaopfoam namelist 
-      !!        
-      !! ** Method : Read namelist
-      !!   History
-      !!   3.4  !  03-14  (P. Sykes) Routine to initialize dia_wri_diaop
-      !!---------------------------------------------------------------------------
-      !!
-      INTEGER            ::   ios      ! Local integer output status for namelist read
-      INTEGER            ::   ierror   ! local integer
-      !!
-      NAMELIST/nam_diadiaop/ ln_diaopfoam
-      !!
-      !!----------------------------------------------------------------------
-      !
-      ln_diaopfoam = .false.         ! default value for diaopfoam stream
-      REWIND ( numnam_ref )              ! Read Namelist nam_diadiaop in reference namelist : 3D hourly diagnostics
-      READ   ( numnam_ref, nam_diadiaop, IOSTAT=ios, ERR= 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadiaop in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist nam_diadiaop in configuration namelist  3D hourly diagnostics
-      READ  ( numnam_cfg, nam_diadiaop, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadiaop in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, nam_diadiaop )
-      !
-      IF(lwp) THEN                   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dia_diaopfoam_init : Output Diaopfoam Diagnostics'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist nam_diadiaop : set diaopfoam outputs '
-         WRITE(numout,*) '      Switch for diaopfoam diagnostics (T) or not (F)  ln_diaopfoam  = ', ln_diaopfoam
-      ENDIF
-    END SUBROUTINE dia_diaopfoam_init
-
-    SUBROUTINE dia_diaopfoam
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE dia_diaopfoam  ***
-      !! ** Purpose :   Write 3D hourly diagnostics for operational use
-      !!
-      !!
-      !! History :
-      !!   3.6  !  11-16  (P. Sykes) 
-      !!         
-      !!--------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace
-      REAL(wp) :: zmdi
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zwu
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zwv
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zwz
-
-      CALL wrk_alloc( jpi , jpj      , zwu )
-      CALL wrk_alloc( jpi , jpj      , zwv )
-      CALL wrk_alloc( jpi , jpj      , zwz )
-
-      zmdi=1.e+20                               !  missing data indicator for masking
-      ! Diaopfoam stream if needed
-      IF (ln_diaopfoam) THEN
-         CALL theta2t
-         CALL iom_put( "insitut_op" , rinsitu_t(:,:,:)                      )    ! insitu temperature
-         CALL iom_put( "toce_op"   , tsn(:,:,:,jp_tem)                     )    ! temperature
-         CALL iom_put( "soce_op"   , tsn(:,:,:,jp_sal)                     )    ! salinity
-         IF (ln_diurnal) THEN
-            CALL iom_put( "sst_wl_op"   , x_dsst                    )    ! warm layer 
-            CALL iom_put( "sst_cs_op"   , x_csdsst                  )    ! cool skin 
-         ENDIF
-         zw2d(:,:)=sshn(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
-         CALL iom_put( "ssh_op"  , zw2d(:,:)                          ) ! sea surface height
-         CALL iom_put( "uoce_op"   , un                                    )    ! i-current      
-         CALL iom_put( "voce_op"   , vn                                    )    ! j-current
-         !CALL iom_put( "woce_op"   , wn                                    )    ! k-current
-#if defined key_spm
-         cltra = TRIM(ctrc3d(5))//"_op"
-         zw3d(:,:,:) = trc3d(:,:,:,5)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) ! Visibility
-         CALL iom_put( cltra, zw3d  )
-#endif
-         CALL calc_max_cur(zwu,zwv,zwz,zmdi)
-         CALL iom_put( "maxu" , zwu                                     ) ! max u current
-         CALL iom_put( "maxv" , zwv                                     ) ! max v current
-         CALL iom_put( "maxz" , zwz                                     ) ! max current depth
-      ENDIF
-   END SUBROUTINE dia_diaopfoam
-
-   SUBROUTINE calc_max_cur(zmax_u, zmax_v, zmax_z, inmdi)
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE calc_max_cur  ***
-      !!
-      !! ** Purpose :   To locate within the water column the magnitude and
-      !!                vertical location of the strongest horizontal
-      !!                current. The vertical component is ignored since it
-      !!                is an order of magnitude smaller than the horizontal
-      !!                flow, in general. 
-      !!
-      !! ** Method :    A. Map U,V to T-grid.
-      !!                B. Calculate the magnitude of the current for every
-      !!                   grid cell.
-      !!                C. Locate the vertical index using FORTRAN's builtin
-      !!                   MAXLOC function.
-      !!                D. Copy the U,V,Z components of the relevant
-      !!                   indices.
-      !!
-      !! ** Returns :   Value of u, v component and depth of maximum
-      !!                horizontal current on T-grid.
-      !!
-      !!---------------------------------------------------------------------
-      IMPLICIT NONE
-      REAL(wp), DIMENSION(jpi, jpj), INTENT(  OUT) :: zmax_u, zmax_v, zmax_z
-      REAL(wp), DIMENSION(jpi, jpj, jpk)           :: zmax_u_t, zmax_v_t
-      REAL(wp), DIMENSION(jpi, jpj, jpk)           :: zcmag
-      REAL(wp), DIMENSION(jpi, jpj)                :: zmaxk
-      REAL(wp),                      INTENT(IN   ) :: inmdi
-      INTEGER :: ji, jj, jk
-
-      ! Initialise output arrays
-      zmax_u(:, :) = inmdi
-      zmax_v(:, :) = inmdi
-      zmax_z(:, :) = inmdi
-      ! Map to T-grid
-      zmax_u_t(:, :, :) = 0._wp
-      zmax_v_t(:, :, :) = 0._wp
-      DO jk = 1,jpk
-         DO jj = 2,jpj
-            DO ji = 2,jpi
-               zmax_u_t(ji, jj, jk) = 0.5 * (un(ji, jj, jk) + un(ji-1, jj, jk))
-               zmax_v_t(ji, jj, jk) = 0.5 * (vn(ji, jj, jk) + vn(ji, jj-1, jk))
-            END DO
-         END DO
-      END DO
-      ! Calculate absolute velocity
-      zcmag = sqrt((zmax_u_t)**2 + (zmax_v_t)**2)
-      ! Find max. current
-      zmaxk = maxloc(zcmag, dim=3)
-      ! Output values
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-             zmax_u(ji, jj) = zmax_u_t(ji, jj, INT(zmaxk(ji, jj)))
-             zmax_v(ji, jj) = zmax_v_t(ji, jj, INT(zmaxk(ji, jj)))
-             zmax_z(ji, jj) = fsdept(ji, jj, INT(zmaxk(ji, jj)))
-         END DO
-      END DO      
-   END SUBROUTINE calc_max_cur
-
-END MODULE diaopfoam
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90	(revision 10250)
+++ 	(revision )
@@ -1,170 +1,0 @@
-MODULE diatmb 
-   !!======================================================================
-   !!                       ***  MODULE  diaharm  ***
-   !! Harmonic analysis of tidal constituents 
-   !!======================================================================
-   !! History :  3.6  !  2014  (E O'Dea)  Original code
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   USE in_out_manager  ! I/O units
-   USE iom             ! I/0 library
-   USE wrk_nemo        ! working arrays
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output 
-   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
-   PUBLIC   dia_tmb                 ! routine called by diawri.F90
-   PUBLIC   dia_calctmb             ! routine called by dia25h.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dia_tmb_init 
-      !!---------------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_tmb_init  ***
-      !!     
-      !! ** Purpose: Initialization of tmb namelist 
-      !!        
-      !! ** Method : Read namelist
-      !!   History
-      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_tmb
-      !!---------------------------------------------------------------------------
-      !!
-      INTEGER ::   ios                 ! Local integer output status for namelist read
-      !
-      NAMELIST/nam_diatmb/ ln_diatmb
-      !!----------------------------------------------------------------------
-      !
-      REWIND ( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
-      READ   ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp )
- 
-      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
-      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, nam_diatmb )
-
-      IF(lwp) THEN                   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) 'Namelist nam_diatmb : set tmb outputs '
-         WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
-      ENDIF
-
-   END SUBROUTINE dia_tmb_init
-
-   SUBROUTINE dia_calctmb( pinfield,pouttmb )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_tmb  ***
-      !!                   
-      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
-      !!
-      !! ** Method  :   
-      !!      use mbathy to find surface, mid and bottom of model levels
-      !!
-      !! History :
-      !!   3.6  !  08-14  (E. O'Dea) Routine based on dia_wri_foam
-      !!----------------------------------------------------------------------
-      !! * Modules used
-
-      ! Routine to map 3d field to top, middle, bottom
-      IMPLICIT NONE
-
-
-      ! Routine arguments
-      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN   ) :: pinfield    ! Input 3d field and mask
-      REAL(wp), DIMENSION(jpi, jpj, 3  ), INTENT(  OUT) :: pouttmb     ! Output top, middle, bottom
-
-
-
-      ! Local variables
-      INTEGER :: ji,jj,jk  ! Dummy loop indices
-
-      ! Local Real
-      REAL(wp)                         ::   zmdi  !  set masked values
-
-      zmdi=1.e+20 !missing data indicator for masking
-
-      ! Calculate top
-      pouttmb(:,:,1) = pinfield(:,:,1)*tmask(:,:,1)  + zmdi*(1.0-tmask(:,:,1))
-
-      ! Calculate middle
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            jk              = max(1,mbathy(ji,jj)/2)
-            pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
-         END DO
-      END DO
-
-      ! Calculate bottom
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            jk              = max(1,mbathy(ji,jj) )
-            pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
-         END DO
-      END DO
-
-   END SUBROUTINE dia_calctmb
-
-
-
-   SUBROUTINE dia_tmb
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE dia_tmb  ***
-      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
-      !!
-      !! ** Method  :   
-      !!      use mbathy to find surface, mid and bottom of model levels
-      !!      calls calctmb to retrieve TMB values before sending to iom_put
-      !!
-      !! History :
-      !!   3.6  !  08-14  (E. O'Dea) 
-      !!         
-      !!--------------------------------------------------------------------
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! temporary workspace 
-      REAL(wp)                         ::   zmdi      ! set masked values
-
-      zmdi=1.e+20 !missing data indicator for maskin
-
-      IF (ln_diatmb) THEN
-         CALL wrk_alloc( jpi , jpj, 3 , zwtmb )
-         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
-         !ssh already output but here we output it masked
-         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )   ! tmb Temperature
-         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
-         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
-         CALL iom_put( "bot_temp" , zwtmb(:,:,3) )    ! tmb Temperature
-!         CALL iom_put( "sotrefml" , hmld_tref(:,:) )    ! "T criterion Mixed Layer Depth
-
-         CALL dia_calctmb(  tsn(:,:,:,jp_sal),zwtmb )
-         CALL iom_put( "top_sal" , zwtmb(:,:,1) )    ! tmb Salinity 
-         CALL iom_put( "mid_sal" , zwtmb(:,:,2) )    ! tmb Salinity
-         CALL iom_put( "bot_sal" , zwtmb(:,:,3) )    ! tmb Salinity
-
-         CALL dia_calctmb(  un(:,:,:),zwtmb )
-         CALL iom_put( "top_u" , zwtmb(:,:,1) )    ! tmb  U Velocity
-         CALL iom_put( "mid_u" , zwtmb(:,:,2) )    ! tmb  U Velocity
-         CALL iom_put( "bot_u" , zwtmb(:,:,3) )    ! tmb  U Velocity
-!Called in  dynspg_ts.F90        CALL iom_put( "baro_u" , un_b )    ! Barotropic  U Velocity
-
-         CALL dia_calctmb(  vn(:,:,:),zwtmb )
-         CALL iom_put( "top_v" , zwtmb(:,:,1) )    ! tmb  V Velocity
-         CALL iom_put( "mid_v" , zwtmb(:,:,2) )    ! tmb  V Velocity
-         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity
-!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
-      ELSE
-         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
-      ENDIF
-
-   END SUBROUTINE dia_tmb
-   !!======================================================================
-END MODULE diatmb
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 10251)
@@ -44,12 +44,7 @@
    USE in_out_manager  ! I/O manager
    USE diadimg         ! dimg direct access file format output
-   USE diatmb          ! Top,middle,bottom output
-   USE dia25h          ! 25h Mean output
-   USE diaopfoam       ! Diaopfoam output
    USE iom
    USE ioipsl
    USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities     
-   USE eosbn2         ! equation of state                (eos_bn2 routine)
-
 
 #if defined key_lim2
@@ -137,5 +132,4 @@
       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop  ! 3D workspace
       !!----------------------------------------------------------------------
       ! 
@@ -144,5 +138,4 @@
       CALL wrk_alloc( jpi , jpj      , z2d )
       CALL wrk_alloc( jpi , jpj, jpk , z3d )
-      CALL wrk_alloc( jpi , jpj, jpk , zrhd , zrhop )
       !
       ! Output the initial state and forcings
@@ -383,27 +376,7 @@
          CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction
       ENDIF
-
-      IF( iom_use("rhop") ) THEN
-         CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) )       ! now in situ and potential density
-         zrhop(:,:,jpk) = 0._wp
-         CALL iom_put( 'rhop', zrhop )
-      ENDIF
-
       !
       CALL wrk_dealloc( jpi , jpj      , z2d )
       CALL wrk_dealloc( jpi , jpj, jpk , z3d )
-      CALL wrk_dealloc( jpi , jpj, jpk , zrhd , zrhop )
-      !
-      ! If we want tmb values 
-
-      IF (ln_diatmb) THEN
-         CALL dia_tmb
-      ENDIF
-      IF (ln_dia25h) THEN
-         CALL dia_25h( kt )
-      ENDIF
-      IF (ln_diaopfoam) THEN
-         CALL dia_diaopfoam
-      ENDIF
       !
       IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
@@ -465,5 +438,7 @@
       zdt = rdt
       IF( nacc == 1 ) zdt = rdtmin
-      clop = "x"         ! no use of the mask value (require less cpu time, and otherwise the model crashes)
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
 #if defined key_diainstant
       zsto = nwrite * zdt
@@ -1045,6 +1020,4 @@
          CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth
             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
-         CALL histdef( id_i, "vovvle3t", "T point thickness"         , "m"      ,   &   ! t-point depth
-            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
       END IF
 
@@ -1077,8 +1050,4 @@
       CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress
       CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress
-      IF( lk_vvl ) THEN
-         CALL histwrite( id_i, "vovvldep", kt, fsdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth       
-         CALL histwrite( id_i, "vovvle3t", kt, fse3t_n (:,:,:), jpi*jpj*jpk, idex )!  T-cell thickness  
-      END IF
 
       ! 3. Close the file
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 10251)
@@ -73,9 +73,4 @@
       !!----------------------------------------------------------------------
       !
-      ! max number of seconds between each restart
-      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
-         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
-            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
-      ENDIF
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
       IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
@@ -243,4 +238,9 @@
                nday_year = 1
                nsec_year = ndt05
+               IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN   ! test integer 4 max value
+                  CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ',   &
+                     &           'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', &
+                     & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' )
+               ENDIF
                nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
                IF( nleapy == 1 )   CALL day_mth
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 10251)
@@ -135,7 +135,6 @@
       !!----------------------------------------------------------------------
       USE ioipsl
-      NAMELIST/namrun/ ln_NOOS
       NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
-         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstdate, ln_rstart , nn_rstctl,   &
+         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
          &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler
@@ -175,5 +174,4 @@
          WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
          WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
-         WRITE(numout,*) '      datestamping of restarts        ln_rstdate  = ', ln_rstdate
          WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
          WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
@@ -194,5 +192,4 @@
          WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
          WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
-         WRITE(numout,*) '      NOOS transect diagnostics       ln_NOOS    = ', ln_NOOS
       ENDIF
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 10251)
@@ -169,40 +169,40 @@
             !
             ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u = 20 km)
-            ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
+            ij0 = 201 + isrow   ;   ij1 = 241 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Gibraltar : e2u reduced to 20 km'
 
             ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km)
-            ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
+            ij0 = 208 + isrow   ;   ij1 = 248 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Bhosporus : e2u reduced to 10 km'
 
             ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v = 13 km)
-            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3
+            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Lombok : e1v reduced to 10 km'
 
             ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
-            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3
+            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Sumba : e1v reduced to 8 km'
 
             ii0 =  53           ;   ii1 =  53        ! Ombai Strait (e1v = 13 km)
-            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
+            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Ombai : e1v reduced to 13 km'
 
             ii0 =  56           ;   ii1 =  56        ! Timor Passage (e1v = 20 km)
-            ij0 = 164 - isrow   ;   ij1 = 145 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
+            ij0 = 124 + isrow   ;   ij1 = 145 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Timor Passage : e1v reduced to 20 km'
 
             ii0 =  55           ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km)
-            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3
+            ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: W Halmahera : e1v reduced to 30 km'
 
             ii0 =  58           ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km)
-            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
+            ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km'
@@ -544,6 +544,5 @@
          IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only
             IF( .NOT. Agrif_Root() ) THEN
-              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m)   & 
-                    &           / (ra * rad)
+              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad)
             ENDIF
          ENDIF
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 10251)
@@ -31,5 +31,4 @@
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
-   USE iom    ! slwa
 
    IMPLICIT NONE
@@ -414,33 +413,33 @@
          IF(lwp) WRITE(numout,*) '      Gibraltar '
          ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait 
-         ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 201 + isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      Bhosporus '
          ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait 
-         ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 208 + isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      Makassar (Top) '
          ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top) 
-         ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+         ij0 = 149 + isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
 
          IF(lwp) WRITE(numout,*) '      Lombok '
          ii0 =  44           ;   ii1 =  44        ! Lombok Strait 
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      Ombai '
          ii0 =  53           ;   ii1 =  53        ! Ombai Strait 
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      Timor Passage '
          ii0 =  56           ;   ii1 =  56        ! Timor Passage 
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      West Halmahera '
          ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait 
-         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+         ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
 
          IF(lwp) WRITE(numout,*) '      East Halmahera '
          ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait 
-         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+         ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
          !
       ENDIF
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 10251)
@@ -215,6 +215,4 @@
          CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d )  !    ! stretched system
          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d )
-         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )     
-         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 )     
       ENDIF
       
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 10251)
@@ -219,13 +219,7 @@
          &  ppsur == pp_to_be_computed           ) THEN
          !
-#if defined key_agrif
-         za1  = (  ppdzmin - pphmax / FLOAT(jpkdta-1)  )                                                   &
-            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpkdta-1) * (  LOG( COSH( (jpkdta - ppkth) / ppacr) )&
-            &                                                      - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
-#else
          za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      &
             & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
             &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
-#endif
          za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr )
          zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
@@ -242,9 +236,5 @@
               WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers'
               WRITE(numout,*) '            Total depth    :', zhmax
-#if defined key_agrif
-              WRITE(numout,*) '            Layer thickness:', zhmax/(jpkdta-1)
-#else
               WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1)
-#endif
          ELSE
             IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
@@ -270,10 +260,6 @@
       ! Reference z-coordinate (depth - scale factor at T- and W-points)
       ! ======================
-      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid 
-#if defined key_agrif
-         za1 = zhmax / FLOAT(jpkdta-1) 
-#else
+      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid       
          za1 = zhmax / FLOAT(jpk-1) 
-#endif
          DO jk = 1, jpk
             zw = FLOAT( jk )
@@ -1884,8 +1870,7 @@
              iim1 = MAX( ji-1, 1 )
              ijm1 = MAX( jj-1, 1 )
-             IF( ( + bathy(iim1,ijp1) + bathy(ji,ijp1) + bathy(iip1,ijp1)  &
-                &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )  &
-                &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp ) THEN
-                zenv(ji,jj) = rn_sbot_min
+             IF( (bathy(iip1,jj) + bathy(iim1,jj) + bathy(ji,ijp1) + bathy(ji,ijm1) +              &
+        &         bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN
+               zenv(ji,jj) = rn_sbot_min
              ENDIF
            ENDIF
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 10251)
@@ -209,5 +209,5 @@
       ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
       !
-      IF( ln_sco .and. 1==0) THEN                   !==   s- or mixed s-zps-coordinate   ==!
+      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
          !
          CALL wrk_alloc( jpk, ztp, zsp )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 10251)
@@ -97,6 +97,6 @@
       IF( nn_timing == 1 )  CALL timing_start('div_cur')
       !
-      CALL wrk_alloc( jpi  , jpj+2, zwu  )
-      CALL wrk_alloc( jpi+2, jpj  , zwv  )
+      CALL wrk_alloc( jpi  , jpj+2, zwu               )
+      CALL wrk_alloc( jpi+4, jpj  , zwv, kistart = -1 )
       !
       IF( kt == nit000 ) THEN
@@ -236,6 +236,6 @@
       CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change)
       !
-      CALL wrk_dealloc( jpi  , jpj+2, zwu )
-      CALL wrk_dealloc( jpi+2, jpj  , zwv )
+      CALL wrk_dealloc( jpi  , jpj+2, zwu               )
+      CALL wrk_dealloc( jpi+4, jpj  , zwv, kistart = -1 )
       !
       IF( nn_timing == 1 )  CALL timing_stop('div_cur')
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 10251)
@@ -24,7 +24,4 @@
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
-#if defined key_bdy 
-   USE bdy_oce         ! ocean open boundary conditions 
-#endif 
 
    IMPLICIT NONE
@@ -81,9 +78,4 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 
-#if defined key_bdy 
-      INTEGER  ::   jb                 ! dummy loop indices 
-      INTEGER  ::   ii, ij, igrd, ib_bdy   ! local integers 
-      INTEGER  ::   fu, fv 
-#endif 
       !!----------------------------------------------------------------------
       !
@@ -105,33 +97,5 @@
       
       zhke(:,:,jpk) = 0._wp
-
-#if defined key_bdy 
-      ! Maria Luneva & Fred Wobus: July-2016 
-      ! compensate for lack of turbulent kinetic energy on liquid bdy points 
-      DO ib_bdy = 1, nb_bdy 
-         IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 
-            igrd = 2           ! Copying normal velocity into points outside bdy 
-            DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
-               DO jk = 1, jpkm1 
-                  ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
-                  ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
-                  fu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 
-                  un(ii-fu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 
-               END DO 
-            END DO 
-            ! 
-            igrd = 3           ! Copying normal velocity into points outside bdy 
-            DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
-               DO jk = 1, jpkm1 
-                  ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
-                  ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
-                  fv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 
-                  vn(ii,ij-fv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 
-               END DO 
-            END DO 
-         ENDIF 
-      ENDDO  
-#endif       
-
+      
       SELECT CASE ( kscheme )             !== Horizontal kinetic energy at T-point  ==!
       !
@@ -148,6 +112,4 @@
             END DO
          END DO
-         !
-         CALL lbc_lnk( zhke, 'T', 1. )
          !
       CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --!
@@ -172,11 +134,4 @@
       END SELECT
       !
-
-#if defined key_bdy 
-      ! restore velocity masks at points outside boundary 
-      un(:,:,:) = un(:,:,:) * umask(:,:,:) 
-      vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 
-#endif  
-
       DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==!
          DO jj = 2, jpjm1
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 10251)
@@ -266,18 +266,6 @@
                ! Add volume filter correction: compatibility with tracer advection scheme
                ! => time filter + conservation correction (only at the first level)
-               IF ( nn_isf == 0) THEN   ! if no ice shelf melting
-                  fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &
-                                 &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
-               ELSE                     ! if ice shelf melting
-                  DO jj = 1,jpj
-                     DO ji = 1,jpi
-                        jk = mikt(ji,jj)
-                        fse3t_b(ji,jj,jk) = fse3t_b(ji,jj,jk) - atfp * rdt * r1_rau0                       &
-                                          &                          * ( (emp_b(ji,jj)    - emp(ji,jj)   ) &
-                                          &                            - (rnf_b(ji,jj)    - rnf(ji,jj)   ) &
-                                          &                            + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk)
-                     END DO
-                  END DO
-               END IF
+               fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &
+                              &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
             ENDIF
             !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 10251)
@@ -41,8 +41,10 @@
    USE timing          ! Timing    
    USE sbcapr          ! surface boundary condition: atmospheric pressure
-   USE diatmb          ! Top,middle,bottom output
    USE dynadv, ONLY: ln_dynadv_vec
 #if defined key_agrif
    USE agrif_opa_interp ! agrif
+#endif
+#if defined key_asminc   
+   USE asminc          ! Assimilation increment
 #endif
 
@@ -142,5 +144,4 @@
       INTEGER  ::   ji, jj, jk, jn   		! dummy loop indices
       INTEGER  ::   ikbu, ikbv, noffset    	! local integers
-      REAL(wp) ::   zmdi
       REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf  	! local scalars
       REAL(wp) ::   zx1, zy1, zx2, zy2         !   -      -
@@ -168,5 +169,4 @@
       CALL wrk_alloc( jpi, jpj, zhf )
       !
-      zmdi=1.e+20                               !  missing data indicator for masking
       !                                         !* Local constant initialization
       z1_12 = 1._wp / 12._wp 
@@ -187,5 +187,5 @@
       !
                                      	                ! time offset in steps for bdy data update
-      IF (.NOT.ln_bt_fw) THEN ; noffset=-nn_baro ; ELSE ;  noffset = 0 ; ENDIF
+      IF (.NOT.ln_bt_fw) THEN ; noffset=-2*nn_baro ; ELSE ;  noffset = 0 ; ENDIF
       !
       IF( kt == nit000 ) THEN             	!* initialisation
@@ -454,9 +454,15 @@
       !                                         ! Surface net water flux and rivers
       IF (ln_bt_fw) THEN
-         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
+         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) )
       ELSE
          zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
-                &                        + fwfisf(:,:) + fwfisf_b(:,:)                     )
-      ENDIF
+                &                        + rdivisf * ( fwfisf(:,:) + fwfisf_b(:,:) )       )
+      ENDIF
+#if defined key_asminc
+      !                                         ! Include the IAU weighted SSH increment
+      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
+         zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
+      ENDIF
+#endif
       !                                   !* Fill boundary data arrays for AGRIF
       !                                   ! ------------------------------------
@@ -517,6 +523,6 @@
          ! Update only tidal forcing at open boundaries
 #if defined key_tide
-         IF ( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) )
-         IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, time_offset=noffset )
+         IF ( lk_bdy .AND. lk_tide )      CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) )
+         IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, koffset=noffset )
 #endif
          !
@@ -894,5 +900,6 @@
 #if defined key_agrif
       ! Save time integrated fluxes during child grid integration
-      ! (used to update coarse grid transports at next time step)
+      ! (used to update coarse grid transports)
+      ! Useless with 2nd order momentum schemes
       !
       IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN
@@ -920,8 +927,4 @@
       CALL wrk_dealloc( jpi, jpj, zhf )
       !
-      IF ( ln_diatmb ) THEN
-         CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) )  ! Barotropic  U Velocity
-         CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) )  ! Barotropic  V Velocity
-      ENDIF
       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts')
       !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 10251)
@@ -31,4 +31,5 @@
    USE bdydyn2d        ! bdy_ssh routine
 #if defined key_agrif
+   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -74,5 +75,5 @@
       INTEGER, INTENT(in) ::   kt                      ! time step
       ! 
-      INTEGER             ::   ji, jj, jk              ! dummy loop indices
+      INTEGER             ::   jk                      ! dummy loop indice
       REAL(wp)            ::   z2dt, z1_rau0           ! local scalars
       !!----------------------------------------------------------------------
@@ -94,19 +95,4 @@
       z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
       IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
-
-#if defined key_asminc
-      !                                                ! Include the IAU weighted SSH increment
-      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
-         CALL ssh_asm_inc( kt )
-#if defined key_vvl
-! Don't directly adjust ssh but change hdivn at all levels instead
-! In trasbc also add in the heat and salt content associated with these changes at each level  
-        DO jk = 1, jpkm1                                 
-                 hdivn(:,:,jk) = hdivn(:,:,jk) - ( ssh_iau(:,:) / ( ht_0(:,:) + 1.0 - ssmask(:,:) ) ) * ( e3t_0(:,:,jk) / fse3t_n(:,:,jk) ) * tmask(:,:,jk) 
-        END DO
-        CALL lbc_lnk( hdivn, 'T', 1. ) ! Not sure that's necessary
-      ENDIF
-#endif
-#endif
 
       !                                           !------------------------------!
@@ -138,4 +124,12 @@
 #endif
 
+#if defined key_asminc
+      !                                                ! Include the IAU weighted SSH increment
+      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
+         CALL ssh_asm_inc( kt )
+         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)
+      ENDIF
+#endif
+
       !                                           !------------------------------!
       !                                           !           outputs            !
@@ -274,9 +268,12 @@
       ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap
          sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )     ! before <-- now filtered
-         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:)    - emp(:,:)    &
-                                &                                 - rnf_b(:,:)    + rnf(:,:)    &
-                                &                                 + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:)
+         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) - rnf_b(:,:) + rnf(:,:) ) * ssmask(:,:)
          sshn(:,:) = ssha(:,:)                           ! now <-- after
       ENDIF
+      !
+      ! Update velocity at AGRIF zoom boundaries
+#if defined key_agrif
+      IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt )
+#endif
       !
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 10251)
@@ -18,8 +18,6 @@
    !!----------------------------------------------------------------------
    USE par_oce        ! NEMO parameters
-   USE phycst         ! for rday
    USE dom_oce        ! NEMO domain
    USE in_out_manager ! NEMO IO routines
-   USE ioipsl, ONLY : ju2ymds    ! for calendar
    USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
    USE netcdf         ! netcdf routines for IO
@@ -233,10 +231,6 @@
       INTEGER ::   jn   ! dummy loop index
       INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim
-      INTEGER             ::   iyear, imonth, iday
-      REAL (wp)           ::   zsec
-      REAL (wp)           ::   zfjulday
-      CHARACTER(len=256)  :: cl_path
-      CHARACTER(len=256)  :: cl_filename
-      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
+      CHARACTER(len=256)     :: cl_path
+      CHARACTER(len=256)     :: cl_filename
       TYPE(iceberg), POINTER :: this
       TYPE(point)  , POINTER :: pt
@@ -246,18 +240,8 @@
       cl_path = TRIM(cn_ocerst_outdir)
       IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
-      IF ( ln_rstdate ) THEN
-         zfjulday = fjulday + rdttra(1) / rday
-         IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
-         CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )           
-         WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
+      IF( lk_mpp ) THEN
+         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1
       ELSE
-         IF( kt > 999999999 ) THEN   ;   WRITE(clkt, *       ) kt
-         ELSE                        ;   WRITE(clkt, '(i8.8)') kt
-         ENDIF
-      ENDIF
-      IF( lk_mpp ) THEN
-         WRITE(cl_filename,'(A,"_icebergs_",A,"_restart_",I4.4,".nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)), narea-1
-      ELSE
-         WRITE(cl_filename,'(A,"_icebergs_",A,"_restart.nc")') TRIM(cexper), TRIM(ADJUSTL(clkt))
+         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt
       ENDIF
       IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename)
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 10251)
@@ -30,5 +30,4 @@
    CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory
    LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file
-   LOGICAL       ::   ln_rstdate       !: datestamping of restarts 
    LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F)
    INTEGER       ::   nn_no            !: job number
@@ -49,5 +48,4 @@
    LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file
    INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
-   LOGICAL       ::   ln_NOOS = .FALSE.                !: NOOS transects  diagnostics
 #if defined key_netcdf4
    !!----------------------------------------------------------------------
@@ -135,11 +133,6 @@
    INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output
    INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output
-   INTEGER ::   numdct_NOOS     =   -1      !: logical unit for NOOS    transports output
-   INTEGER ::   numdct_NOOS_h   =   -1      !: logical unit for NOOS hourly transports output
    INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output
    INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output
-   
-   INTEGER ::   numdct_reg_bin  =   -1      !: logical unit for NOOS    transports output
-   INTEGER ::   numdct_reg_txt  =   -1      !: logical unit for NOOS hourly transports output
 
    !!----------------------------------------------------------------------
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 10251)
@@ -94,21 +94,13 @@
       CHARACTER(len=*), INTENT(in)  :: cdname
 #if defined key_iomput
-#if ! defined key_xios2
-      TYPE(xios_time)     :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
-      CHARACTER(len=19)   :: cldate 
-#else
-      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
-      TYPE(xios_date)     :: start_date
-#endif
-      CHARACTER(len=10)   :: clname
-      INTEGER             :: ji
+      TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
+      CHARACTER(len=19) :: cldate 
+      CHARACTER(len=10) :: clname
+      INTEGER           ::   ji
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds
       !!----------------------------------------------------------------------
-#if ! defined key_xios2
+
       ALLOCATE( z_bnds(jpk,2) )
-#else
-      ALLOCATE( z_bnds(2,jpk) )
-#endif
 
       clname = cdname
@@ -118,5 +110,4 @@
 
       ! calendar parameters
-#if ! defined key_xios2
       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
       CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian")
@@ -126,20 +117,7 @@
       WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday 
       CALL xios_set_context_attr(TRIM(clname), start_date=cldate )
-#else
-      ! Calendar type is now defined in xml file 
-      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
-      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), &
-          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
-      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), &
-          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
-      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), &
-          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
-      END SELECT
-#endif
+
       ! horizontal grid definition
-
-#if ! defined key_xios2
       CALL set_scalar
-#endif
 
       IF( TRIM(cdname) == TRIM(cxios_context) ) THEN  
@@ -192,29 +170,14 @@
 
       ! Add vertical grid bounds
-#if ! defined key_xios2
       z_bnds(:      ,1) = gdepw_1d(:)
       z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk)
       z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk)
-#else
-      z_bnds(1      ,:) = gdepw_1d(:)
-      z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk)
-      z_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk)
-#endif
-
       CALL iom_set_axis_attr( "deptht", bounds=z_bnds )
       CALL iom_set_axis_attr( "depthu", bounds=z_bnds )
       CALL iom_set_axis_attr( "depthv", bounds=z_bnds )
-
-#if ! defined key_xios2
-      z_bnds(:    ,2)  = gdept_1d(:)
-      z_bnds(2:jpk,1)  = gdept_1d(1:jpkm1)
-      z_bnds(1    ,1)  = gdept_1d(1) - e3w_1d(1)
-#else
-      z_bnds(2,:    )  = gdept_1d(:)
-      z_bnds(1,2:jpk)  = gdept_1d(1:jpkm1)
-      z_bnds(1,1    )  = gdept_1d(1) - e3w_1d(1)
-#endif
+      z_bnds(:    ,2) = gdept_1d(:)
+      z_bnds(2:jpk,1) = gdept_1d(1:jpkm1)
+      z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1)
       CALL iom_set_axis_attr( "depthw", bounds=z_bnds )
-
 
 # if defined key_floats
@@ -1195,5 +1158,4 @@
       LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask
 
-#if ! defined key_xios2
       IF ( xios_is_valid_domain     (cdid) ) THEN
          CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
@@ -1202,5 +1164,6 @@
             &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  &
             &    bounds_lat=bounds_lat, area=area )
-     ENDIF
+      ENDIF
+
       IF ( xios_is_valid_domaingroup(cdid) ) THEN
          CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
@@ -1210,34 +1173,7 @@
             &    bounds_lat=bounds_lat, area=area )
       ENDIF
-
-#else
-      IF ( xios_is_valid_domain     (cdid) ) THEN
-         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
-            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
-            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
-            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
-     ENDIF
-      IF ( xios_is_valid_domaingroup(cdid) ) THEN
-         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
-            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
-            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
-            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
-      ENDIF
-#endif
       CALL xios_solve_inheritance()
 
    END SUBROUTINE iom_set_domain_attr
-
-#if defined key_xios2
-  SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj)
-     CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
-     INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj
-
-     IF ( xios_is_valid_domain     (cdid) ) THEN
-         CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    &
-           &   nj=nj)
-    ENDIF
-  END SUBROUTINE iom_set_zoom_domain_attr
-#endif
 
 
@@ -1247,11 +1183,6 @@
       REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
       IF ( PRESENT(paxis) ) THEN
-#if ! defined key_xios2
          IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis )
          IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )
-#else
-         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis )
-         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis )
-#endif
       ENDIF
       IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds )
@@ -1260,19 +1191,14 @@
    END SUBROUTINE iom_set_axis_attr
 
+
    SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
       CHARACTER(LEN=*)          , INTENT(in) ::   cdid
-#if ! defined key_xios2
-      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_op
-      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_offset
-#else
-      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_op
-      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_offset
-#endif
-      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       &
-    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
-      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  &
-    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset
+      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset )
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_field_attr
+
 
    SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
@@ -1287,19 +1213,10 @@
    SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
       CHARACTER(LEN=*)          , INTENT(in ) ::   cdid
-      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix
-#if ! defined key_xios2
-      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::    output_freq
-#else
-      TYPE(xios_duration)   ,OPTIONAL , INTENT(out) :: output_freq
-#endif  
+      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix, output_freq
       LOGICAL                                 ::   llexist1,llexist2,llexist3
       !---------------------------------------------------------------------
       IF( PRESENT( name        ) )   name = ''          ! default values
       IF( PRESENT( name_suffix ) )   name_suffix = ''
-#if ! defined key_xios2
       IF( PRESENT( output_freq ) )   output_freq = ''
-#else
-      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0)
-#endif
       IF ( xios_is_valid_file     (cdid) ) THEN
          CALL xios_solve_inheritance()
@@ -1322,11 +1239,6 @@
       CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
       LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
-#if ! defined key_xios2
       IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask )
       IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask )
-#else
-      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask3=mask )
-      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask3=mask )
-#endif
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_grid_attr
@@ -1370,9 +1282,5 @@
       ni=nlei-nldi+1 ; nj=nlej-nldj+1
 
-#if ! defined key_xios2
-     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
-#else
-     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
-#endif     
+      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
       CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   &
@@ -1522,6 +1430,4 @@
       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0.
 
-      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
-#if ! defined key_xios2
       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
@@ -1529,14 +1435,6 @@
          &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
       !
+      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
       CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)
-#else
-! Pas teste : attention aux indices !
-      CALL iom_set_domain_attr("ptr", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
-      CALL iom_set_domain_attr("ptr", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
-      CALL iom_set_domain_attr("ptr", lonvalue = zlon,   &
-         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
-       CALL iom_set_zoom_domain_attr ('ptr', ibegin=ix, nj=jpjglo)
-#endif
-
       CALL iom_update_file_name('ptr')
       !
@@ -1557,5 +1455,5 @@
       zz=REAL(narea,wp)
       CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
-      
+
    END SUBROUTINE set_scalar
 
@@ -1581,24 +1479,12 @@
       REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
       REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
-#if  defined key_xios2
-      TYPE(xios_duration)            ::   f_op, f_of
-#endif
- 
       !!----------------------------------------------------------------------
       ! 
       ! frequency of the call of iom_put (attribut: freq_op)
-#if ! defined key_xios2
-      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts')
-      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op=cl1//'ts', freq_offset='0ts')
-      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op=cl1//'ts', freq_offset='0ts')
-      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op=cl1//'ts', freq_offset='0ts')
-      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op=cl1//'ts', freq_offset='0ts')
-#else
-      f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
-      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
-      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
-      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of)
-      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of)
-#endif
+      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts')
+      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op = cl1//'ts', freq_offset='0ts')
+      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op = cl1//'ts', freq_offset='0ts')
+      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op = cl1//'ts', freq_offset='0ts')
+      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op = cl1//'ts', freq_offset='0ts')
        
       ! output file names (attribut: name)
@@ -1622,9 +1508,5 @@
          ! Equatorial section (attributs: jbegin, ni, name_suffix)
          CALL dom_ngb( 0., 0., ix, iy, cl1 )
-#if ! defined key_xios2
          CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
-#else
-         CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo)
-#endif
          CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
          CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
@@ -1706,9 +1588,5 @@
                ENDIF
                clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
-#if ! defined key_xios2
                CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
-#else
-               CALL iom_set_zoom_domain_attr  (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1)
-#endif
                CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         )
                CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
@@ -1739,17 +1617,9 @@
       REAL(wp)           ::   zsec
       LOGICAL            ::   llexist
-#if  defined key_xios2
-      TYPE(xios_duration)   ::   output_freq 
-#endif      
-      !!----------------------------------------------------------------------
-
+      !!----------------------------------------------------------------------
 
       DO jn = 1,2
-#if ! defined key_xios2
+
          IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq )
-#else
-         output_freq = xios_duration(0,0,0,0,0,0)
-         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq )
-#endif
          IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname )
 
@@ -1762,5 +1632,4 @@
             END DO
 
-#if ! defined key_xios2
             idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
             DO WHILE ( idx /= 0 ) 
@@ -1775,27 +1644,5 @@
                idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
             END DO
-#else
-            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
-            DO WHILE ( idx /= 0 ) 
-              IF ( output_freq%hour /= 0 ) THEN
-                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 
-                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
-              ELSE IF ( output_freq%day /= 0 ) THEN
-                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 
-                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
-              ELSE IF ( output_freq%month /= 0 ) THEN   
-                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 
-                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
-              ELSE IF ( output_freq%year /= 0 ) THEN   
-                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 
-                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
-              ELSE
-                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
-                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
-              ENDIF
-              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
-              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
-            END DO
-#endif
+
             idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
             DO WHILE ( idx /= 0 ) 
@@ -1826,5 +1673,4 @@
             END DO
 
-            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
             IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
             IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
@@ -1874,6 +1720,4 @@
       ENDIF
       
-!$AGRIF_DO_NOT_TREAT      
-! Should be fixed in the conv
       IF( llfull ) THEN 
          clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
@@ -1886,5 +1730,4 @@
          WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
       ENDIF
-!$AGRIF_END_DO_NOT_TREAT      
 
    END FUNCTION iom_sdate
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 10251)
@@ -43,5 +43,5 @@
    INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1)
 
-   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 200   !: maximum number of simultaneously opened file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100   !: maximum number of simultaneously opened file
    INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 600  !: maximum number of variables in one file
    INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 10251)
@@ -21,5 +21,4 @@
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE ioipsl, ONLY : ju2ymds    ! for calendar
    USE eosbn2          ! equation of state            (eos bn2 routine)
    USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
@@ -55,11 +54,8 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt     ! ocean time-step
-      INTEGER             ::   iyear, imonth, iday
-      REAL (wp)           ::   zsec
-      REAL (wp)           ::   zfjulday
       !!
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
       CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
-      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file
+      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file
       !!----------------------------------------------------------------------
       !
@@ -85,14 +81,7 @@
       IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
          IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
-            IF ( ln_rstdate ) THEN
-               zfjulday = fjulday + rdttra(1) / rday
-               IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
-               CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )           
-               WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
-            ELSE
-               ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-               IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-               ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
-               ENDIF
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
             ENDIF
             ! create the file
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 10251)
@@ -298,12 +298,4 @@
       ENDIF
 
-#if defined key_agrif
-      IF (Agrif_Root()) THEN
-         CALL Agrif_MPI_Init(mpi_comm_opa)
-      ELSE
-         CALL Agrif_MPI_set_grid_comm(mpi_comm_opa)
-      ENDIF
-#endif
-
       CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
       CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 10251)
@@ -32,5 +32,4 @@
    PUBLIC   fld_map    ! routine called by tides_init
    PUBLIC   fld_read, fld_fill   ! called by sbc... modules
-   PUBLIC   fld_clopn
 
    TYPE, PUBLIC ::   FLD_N      !: Namelist field informations
@@ -816,12 +815,4 @@
          imonth = kmonth
          iday = kday
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
-            isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )  
-            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
-            llprevyr   = llprevmth .AND. nmonth == 1
-            iyear  = nyear  - COUNT((/llprevyr /))
-            imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
-            iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
-         ENDIF
       ELSE                                                  ! use current day values
          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
@@ -1290,5 +1281,5 @@
       CHARACTER(LEN=*)          , INTENT(in   ) ::   lsmfile ! land sea mask file name
       !! 
-      REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta                          ! temporary array of values on input grid
+      REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta,zfieldo                  ! temporary array of values on input grid
       INTEGER, DIMENSION(3)                     ::   rec1,recn                             ! temporary arrays for start and length
       INTEGER, DIMENSION(3)                     ::   rec1_lsm,recn_lsm                     ! temporary arrays for start and length in case of seaoverland
@@ -1356,6 +1347,6 @@
 
 
-         itmpi=jpi2_lsm-jpi1_lsm+1
-         itmpj=jpj2_lsm-jpj1_lsm+1
+         itmpi=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),1)
+         itmpj=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),2)
          itmpz=kk
          ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz))
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 10251)
@@ -121,7 +121,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pressnow          !: UKMO SHELF pressure
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgu              !: UKMO SHELF pressure forcing
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   apgv              !: UKMO SHELF pressure forcing
 #if defined key_cpl_carbon_cycle
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
@@ -174,5 +171,4 @@
 #endif
          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
-         &      pressnow(jpi,jpj), apgu(jpi,jpj)    , apgv(jpi,jpj) ,     &
          &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
          !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 10251)
@@ -403,8 +403,4 @@
          CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
          CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
-         tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac   ! output total precipitation [kg/m2/s]
-         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac   ! output solid precipitation [kg/m2/s]
-         CALL iom_put( 'snowpre', sprecip * 86400. )        ! Snow
-         CALL iom_put( 'precip' , tprecip * 86400. )        ! Total precipitation
       ENDIF
       !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 10251)
@@ -1029,5 +1029,4 @@
          ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
          ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
-         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssu_m', ssu_m )
       ENDIF
@@ -1035,5 +1034,4 @@
          ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
          vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
-         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
          CALL iom_put( 'ssv_m', ssv_m )
       ENDIF
@@ -1745,5 +1743,5 @@
                      ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
                   ELSEWHERE
-                     ztmp3(:,:,1) = rt0
+                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)
                   END WHERE
                CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
@@ -1776,40 +1774,11 @@
       !                                                      ! ------------------------- !
       IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
-          SELECT CASE( sn_snd_alb%cldes )
-          CASE( 'ice' )
-             SELECT CASE( sn_snd_alb%clcat )
-             CASE( 'yes' )   
-                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
-             CASE( 'no' )
-                WHERE( SUM( a_i, dim=3 ) /= 0. )
-                   ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
-                ELSEWHERE
-                   ztmp1(:,:) = albedo_oce_mix(:,:)
-                END WHERE
-             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
-             END SELECT
-          CASE( 'weighted ice' )   ;
-             SELECT CASE( sn_snd_alb%clcat )
-             CASE( 'yes' )   
-                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
-             CASE( 'no' )
-                WHERE( fr_i (:,:) > 0. )
-                   ztmp1(:,:) = SUM (  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
-                ELSEWHERE
-                   ztmp1(:,:) = 0.
-                END WHERE
-             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
-             END SELECT
-          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
+         SELECT CASE( sn_snd_alb%cldes )
+         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
+         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
          END SELECT
-
-         SELECT CASE( sn_snd_alb%clcat )
-            CASE( 'yes' )   
-               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode
-            CASE( 'no'  )   
-               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
-         END SELECT
-      ENDIF
-
+         CALL cpl_snd( jps_albice, isec, ztmp3, info )
+      ENDIF
       IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
          ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 10251)
@@ -22,5 +22,4 @@
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! work arrays
 
    IMPLICIT NONE
@@ -29,5 +28,5 @@
    PUBLIC sbc_flx       ! routine called by step.F90
 
-   INTEGER , PARAMETER ::   jpfld   = 6   ! maximum number of files to read 
+   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read 
    INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
    INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
@@ -35,10 +34,5 @@
    INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
    INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
-   INTEGER , PARAMETER ::   jp_press = 6  ! index of pressure for UKMO shelf fluxes
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
-   LOGICAL , PUBLIC    ::   ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag
-   LOGICAL , PUBLIC    ::   ln_rel_wind = .FALSE.  ! UKMO SHELF specific flux flag - relative winds
-   REAL(wp)            ::   rn_wfac                ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem)
-   INTEGER             ::   jpfld_local   ! maximum number of files to read (locally modified depending on ln_shelf_flx) 
 
    !! * Substitutions
@@ -88,18 +82,9 @@
       REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
       REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
-      REAL     ::   cs                    ! UKMO SHELF: Friction co-efficient at surface
-      REAL     ::   totwindspd            ! UKMO SHELF: Magnitude of wind speed vector
-      REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_i, zwnd_j    ! wind speed components at T-point
-
-      REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3
-      REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient 
       !!
       CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
-      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press  !  informations about the fields to be read 
-      LOGICAL     ::   ln_foam_flx  = .FALSE.                     ! UKMO FOAM specific flux flag 
-      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp,   & 
-      &                    ln_foam_flx, sn_press, ln_shelf_flx, ln_rel_wind,    &
-      &                    rn_wfac
+      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
+      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
       !!---------------------------------------------------------------------
       !
@@ -124,18 +109,9 @@
          slf_i(jp_emp ) = sn_emp
          !
-            ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
-            IF( ln_shelf_flx ) slf_i(jp_press) = sn_press
-   
-            ! define local jpfld depending on shelf_flx logical
-            IF( ln_shelf_flx ) THEN
-               jpfld_local = jpfld
-            ELSE
-               jpfld_local = jpfld-1
-            ENDIF
-            !
+         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
          IF( ierror > 0 ) THEN   
             CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN  
          ENDIF
-         DO ji= 1, jpfld_local
+         DO ji= 1, jpfld
             ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
             IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
@@ -152,60 +128,14 @@
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency
 
-         !!UKMO SHELF wind speed relative to surface currents - put here to allow merging with coupling branch
-         IF( ln_shelf_flx ) THEN
-            CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j )
-
-            IF( ln_rel_wind ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) - rn_wfac * ssu_m(ji,jj)
-                     zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) - rn_wfac * ssv_m(ji,jj)
-                  END DO
-               END DO
-            ELSE
-               zwnd_i(:,:) = sf(jp_utau)%fnow(:,:,1)
-               zwnd_j(:,:) = sf(jp_vtau)%fnow(:,:,1)
-            ENDIF
-         ENDIF
-
          IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle
          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
          ENDIF
 !CDIR COLLAPSE
-            !!UKMO SHELF effect of atmospheric pressure on SSH
-            ! If using ln_apr_dyn, this is done there so don't repeat here.
-            IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj)
-                     apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj)
-                  END DO
-               END DO
-            ENDIF ! ln_shelf_flx
-
          DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
             DO ji = 1, jpi
-                   IF( ln_shelf_flx ) THEN
-                      !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing
-                      pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1)
-                      !! UKMO SHELF flux files contain wind speed not wind stress
-                      totwindspd = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj))
-                      cs = 0.63 + (0.066 * totwindspd)
-                      utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * totwindspd
-                      vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * totwindspd
-                   ELSE
-                      utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
-                      vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
-                   ENDIF
-                   qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1)
-                   IF( ln_foam_flx .OR. ln_shelf_flx ) THEN
-                      !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot)
-                      qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1)
-                      !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P
-                      emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1)
-                   ELSE
-                      qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
-                      emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
-                   ENDIF
+               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
+               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
+               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
+               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
             END DO
          END DO
@@ -213,11 +143,4 @@
          qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST
          !
-   
-            !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe
-            IF( ln_foam_flx ) THEN
-               CALL lbc_lnk( utau(:,:), 'U', -1. )
-               CALL lbc_lnk( vtau(:,:), 'V', -1. )
-            ENDIF
-    
          !                                                        ! module of wind stress and wind speed at T-point
          zcoef = 1. / ( zrhoa * zcdrag )
@@ -239,5 +162,5 @@
             WRITE(numout,*) 
             WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
-            DO jf = 1, jpfld_local
+            DO jf = 1, jpfld
                IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
                IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
@@ -250,8 +173,4 @@
          ENDIF
          !
-         IF( ln_shelf_flx ) THEN
-            CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j )
-         ENDIF
-         !
       ENDIF
       !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 10251)
@@ -108,5 +108,5 @@
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area   ! sum over the global domain
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain
             zcoef = z_fwf * rcp
             emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1)
@@ -162,5 +162,5 @@
             zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
             !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
-            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
+            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
             !            
             IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 10251)
@@ -103,6 +103,5 @@
                                  ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
          
-         CALL eos_fzp( sss_m(:,:), fr_i(:,:) )       ! sea surface freezing temperature [Celcius]
-         fr_i(:,:) = fr_i(:,:) * tmask(:,:,1)
+         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius]
 
          IF( ln_cpl )   a_i(:,:,1) = fr_i(:,:)         
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 10251)
@@ -126,7 +126,6 @@
          
          ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) )
-         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
-          
+         t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )  
+         
          ! Mask sea ice surface temperature (set to rt0 over land)
          DO jl = 1, jpl
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 10251)
@@ -150,6 +150,5 @@
 
          ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         CALL eos_fzp( sss_m(:,:), tfu(:,:) )
-         tfu(:,:) = tfu(:,:) + rt0
+         tfu(:,:) = eos_fzp( sss_m ) +  rt0 
 
          zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 10251)
@@ -53,5 +53,11 @@
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  risfLeff               !:effective length (Leff) BG03 nn_isf==2
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point
+#if defined key_agrif
+   ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals
+   REAL(wp),    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base
+                                                                                          !: (first wet level and last level include in the tbl)
+#else
    INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base
+#endif
 
 
@@ -86,6 +92,5 @@
     REAL(wp)                     ::   rmin
     REAL(wp)                     ::   zhk
-    REAL(wp)                     ::   zt_frz, zpress
-    CHARACTER(len=256)           ::   cfisf , cvarzisf, cvarhisf   ! name for isf file
+    CHARACTER(len=256)           ::   cfisf, cvarzisf, cvarhisf   ! name for isf file
     CHARACTER(LEN=256)           :: cnameis                     ! name of iceshelf file
     CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale
@@ -171,5 +176,5 @@
               DO jj = 1, jpj
                   jk = 2
-                  DO WHILE ( jk .LE. mbkt(ji,jj) .AND. gdepw_0(ji,jj,jk) < rzisf_tbl(ji,jj) ) ;  jk = jk + 1 ;  END DO
+                  DO WHILE ( jk .LE. mbkt(ji,jj) .AND. fsdepw(ji,jj,jk) < rzisf_tbl(ji,jj) ) ;  jk = jk + 1 ;  END DO
                   misfkt(ji,jj) = jk-1
                END DO
@@ -189,7 +194,28 @@
          END IF
          
-         ! save initial top boundary layer thickness         
          rhisf_tbl_0(:,:) = rhisf_tbl(:,:)
 
+         ! compute bottom level of isf tbl and thickness of tbl below the ice shelf
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = misfkt(ji,jj)
+               ikb = misfkt(ji,jj)
+               ! thickness of boundary layer at least the top level thickness
+               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt))
+
+               ! determine the deepest level influenced by the boundary layer
+               ! test on tmask useless ?????
+               DO jk = ikt, mbkt(ji,jj)
+                  IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+               END DO
+               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
+               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl
+               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
+
+               zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1
+               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
+            END DO
+         END DO
+         
       END IF
 
@@ -204,24 +230,4 @@
       IF( MOD( kt-1, nn_fsbc) == 0 ) THEN
 
-         ! compute bottom level of isf tbl and thickness of tbl below the ice shelf
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               ikt = misfkt(ji,jj)
-               ikb = misfkt(ji,jj)
-               ! thickness of boundary layer at least the top level thickness
-               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt))
-
-               ! determine the deepest level influenced by the boundary layer
-               DO jk = ikt, mbkt(ji,jj)
-                  IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
-               END DO
-               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
-               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl
-               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
-
-               zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1
-               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
-            END DO
-         END DO
 
          ! compute salf and heat flux
@@ -264,19 +270,10 @@
          END IF
          ! compute tsc due to isf
-         ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable).
-!         zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04
-         zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )
-         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 !
+         ! WARNING water add at temp = 0C, correction term is added in trasbc, maybe better here but need a 3D variable).
+         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp !
          
          ! salt effect already take into account in vertical advection
          risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0
-
-         ! output
-         IF( iom_use('qisf'  ) )   CALL iom_put('qisf'  , qisf)
-         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
-
-         ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now
-         fwfisf(:,:) = rdivisf * fwfisf(:,:)         
- 
+          
          ! lbclnk
          CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.)
@@ -298,4 +295,7 @@
          ENDIF
          ! 
+         ! output
+         CALL iom_put('qisf'  , qisf)
+         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
       END IF
   
@@ -370,5 +370,5 @@
              ! Calculate freezing temperature
                 zpress = grav*rau0*fsdept(ji,jj,ik)*1.e-04 
-                CALL eos_fzp(tsb(ji,jj,ik,jp_sal), zt_frz, zpress) 
+                zt_frz = eos_fzp(tsb(ji,jj,ik,jp_sal), zpress) 
                 zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik)  ! sum temp
              ENDDO
@@ -452,5 +452,5 @@
       zti(:,:)=tinsitu( ttbl, stbl, zpress )
 ! Calculate freezing temperature
-      CALL eos_fzp( sss_m(:,:), zfrz(:,:), zpress )
+      zfrz(:,:)=eos_fzp( sss_m(:,:), zpress )
 
       
@@ -472,6 +472,9 @@
 
                      nit = nit + 1
-                     IF (nit .GE. 100) CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
-
+                     IF (nit .GE. 100) THEN
+                        !WRITE(numout,*) "sbcisf : too many iteration ... ", zhtflx, zhtflx_b,zgammat, rn_gammat0, rn_tfri2, nn_gammablk, ji,jj
+                        !WRITE(numout,*) "sbcisf : too many iteration ... ", (zhtflx - zhtflx_b)/zhtflx
+                        CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
+                     END IF
 ! save gammat and compute zhtflx_b
                      zgammat2d(ji,jj)=zgammat
@@ -791,5 +794,5 @@
                ! test on tmask useless ?????
                DO jk = ikt, mbkt(ji,jj)
-                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+!                  IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
                END DO
                rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 10251)
@@ -179,9 +179,8 @@
 
       !                          ! Checks:
-      IF( nn_isf .EQ. 0 ) THEN                      ! variable initialisation if no ice shelf 
+      IF( nn_isf .EQ. 0 ) THEN                      ! no specific treatment in vicinity of ice shelf 
          IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
-         fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp
-         risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp
-         rdivisf       = 0.0_wp
+         fwfisf  (:,:) = 0.0_wp
+         fwfisf_b(:,:) = 0.0_wp
       END IF
       IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 10251)
@@ -52,5 +52,5 @@
    REAL(wp)                   ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used
    REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s]
-   REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff
+   REAL(wp)                   ::   rn_rfact        !: multiplicative factor for runoff
 
    LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis
@@ -125,4 +125,12 @@
       IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
       IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
+      !
+      ! Runoff reduction only associated to the ORCA2_LIM configuration
+      ! when reading the NetCDF file runoff_1m_nomask.nc
+      IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN
+         WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
+            sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+         END WHERE
+      ENDIF
       !
       IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 10251)
@@ -42,5 +42,4 @@
    LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term 
    REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
-   LOGICAL         ::   ln_UKMO_haney   ! UKMO specific flag to calculate Haney forcing  
 
    REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
@@ -80,12 +79,4 @@
       INTEGER  ::   ierror   ! return error code
       !!
-      REAL(wp) ::   sst1,sst2                      ! sea surface temperature
-      REAL(wp) ::   e_sst1, e_sst2                 ! saturation vapour pressure
-      REAL(wp) ::   qs1,qs2                        ! specific humidity
-      REAL(wp) ::   pr_tmp                         ! temporary variable for pressure
- 
-      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc1    ! Haney forcing for sensible heat, correction for latent heat   
-      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc2    ! Haney forcing for sensible heat, correction for latent heat   
-      !!
       CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
@@ -104,32 +95,11 @@
             !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
-                  IF( ln_UKMO_haney ) THEN
-                     DO jj = 1, jpj
-                        DO ji = 1, jpi
-                           sst1   =  sst_m(ji,jj)
-                           sst2   =  sf_sst(1)%fnow(ji,jj,1)   
-                           e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1))
-                           e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2))         
-                           pr_tmp = 0.01*pressnow(ji,jj)  !pr_tmp = 1012.0
-                           qs1    = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1)
-                           qs2    = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2)
-                           hny_frc1(ji,jj) = sst1-sst2                   
-                           hny_frc2(ji,jj) = qs1-qs2                     
-                          !Might need to mask off land points.
-                           hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42
-                           hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0
-                           qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj)   
-                           qrp(ji,jj) = 0.e0
-                        END DO
-                     END DO
-                  ELSE
-                     DO jj = 1, jpj
-                        DO ji = 1, jpi
-                           zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
-                           qns(ji,jj) = qns(ji,jj) + zqrp
-                           qrp(ji,jj) = zqrp
-                        END DO
-                     END DO
-                  ENDIF
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
+                     qns(ji,jj) = qns(ji,jj) + zqrp
+                     qrp(ji,jj) = zqrp
+                  END DO
+               END DO
                CALL iom_put( "qrp", qrp )                             ! heat flux damping
             ENDIF
@@ -193,5 +163,5 @@
       CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
-      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd, ln_UKMO_haney
+      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd
       INTEGER     ::  ios
       !!----------------------------------------------------------------------
@@ -219,5 +189,4 @@
          WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
          WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
-         WRITE(numout,*) '      Haney forcing                          ln_UKMO_haney = ', ln_UKMO_haney
       ENDIF
       !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90	(revision 10251)
@@ -28,16 +28,2 @@
    Wave(18) = tide(  'L2'     , 0.006694 ,    2   ,  2 , -1 ,  2 , -1 ,  0  , +180  ,  2   , -2   ,  0   ,  0   , 0 ,  215    )
    Wave(19) = tide(  'T2'     , 0.006614 ,    2   ,  2 ,  0 , -1 ,  0 ,  1  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )
-   !
-   !             !! name_tide , equitide , nutide , nt , ns , nh , np , np1 , shift , nksi , nnu0 , nnu1 , nnu2 , R , formula !!
-   Wave(20) = tide(  'MNS2'   , 0.000000 ,    2   ,  2 , -5 ,  4 ,  1 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    6    )
-   Wave(21) = tide(  'Lam2'   , 0.001760 ,    2   ,  2 , -1 ,  0 ,  1 ,  0  , +180  ,  2   , -2   ,  0   ,  0   , 0 ,   78    )
-   Wave(22) = tide(  'MSN2'   , 0.000000 ,    2   ,  2 ,  1 ,  0 ,  1 ,  0  ,    0  ,  2   , -2   ,  0   ,  2   , 0 ,    6    )
-   Wave(23) = tide(  '2SM2'   , 0.000000 ,    2   ,  2 ,  2 , -2 ,  0 ,  0  ,    0  , -2   ,  2   ,  0   ,  0   , 0 ,   16    )
-   Wave(24) = tide(  'MO3'    , 0.000000 ,    3   ,  3 , -4 ,  1 ,  0 ,  0  ,  +90  ,  2   , -2   ,  0   ,  0   , 0 ,   13    )
-   Wave(25) = tide(  'MK3'    , 0.000000 ,    3   ,  3 , -2 ,  3 ,  0 ,  0  ,  -90  ,  2   , -2   , -1   ,  0   , 0 ,   10    )
-   Wave(26) = tide(  'MN4'    , 0.000000 ,    4   ,  4 , -5 ,  4 ,  1 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    1    )
-   Wave(27) = tide(  'MS4'    , 0.000000 ,    4   ,  4 , -2 ,  2 ,  0 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    2    )
-   Wave(28) = tide(  'M6'     , 0.000000 ,    6   ,  6 , -6 ,  6 ,  0 ,  0  ,    0  ,  6   , -6   ,  0   ,  0   , 0 ,    4    )
-   Wave(29) = tide(  '2MS6'   , 0.000000 ,    6   ,  6 , -4 ,  4 ,  0 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    6    )
-   Wave(30) = tide(  '2MK6'   , 0.000000 ,    6   ,  6 , -4 ,  6 ,  0 ,  0  ,    0  ,  4   , -4   ,  0   , -2   , 0 ,    5    )
-   Wave(31) = tide(  '3M2S2'  , 0.000000 ,    2   , 2  , -6 ,  6 ,  0 ,  0  ,    0  ,  6   , -6   ,  0   ,  0   , 0 ,   12    )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 10251)
@@ -16,8 +16,8 @@
    PUBLIC   tide_init_Wave   ! called by tideini and diaharm modules
 
-   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 31   !: maximum number of harmonic
+   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 19   !: maximum number of harmonic
 
    TYPE, PUBLIC ::    tide
-      CHARACTER(LEN=5) ::   cname_tide
+      CHARACTER(LEN=4) ::   cname_tide
       REAL(wp)         ::   equitide
       INTEGER          ::   nutide
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 10251)
@@ -31,5 +31,5 @@
 CONTAINS
 
-   SUBROUTINE upd_tide( kt, kit, time_offset )
+   SUBROUTINE upd_tide( kt, kit, kbaro, koffset )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE upd_tide  ***
@@ -42,8 +42,8 @@
       !!----------------------------------------------------------------------      
       INTEGER, INTENT(in)           ::   kt      ! ocean time-step index
-      INTEGER, INTENT(in), OPTIONAL ::   kit     ! external mode sub-time-step index (lk_dynspg_ts=T)
-      INTEGER, INTENT(in), OPTIONAL ::   time_offset ! time offset in number 
-                                                     ! of internal steps             (lk_dynspg_ts=F)
-                                                     ! of external steps             (lk_dynspg_ts=T)
+      INTEGER, INTENT(in), OPTIONAL ::   kit     ! external mode sub-time-step index (lk_dynspg_ts=T only)
+      INTEGER, INTENT(in), OPTIONAL ::   kbaro   ! number of sub-time-step           (lk_dynspg_ts=T only)
+      INTEGER, INTENT(in), OPTIONAL ::   koffset ! time offset in number 
+                                                 ! of sub-time-steps                 (lk_dynspg_ts=T only)
       !
       INTEGER  ::   joffset      ! local integer
@@ -57,8 +57,8 @@
       !
       joffset = 0
-      IF( PRESENT( time_offset ) )   joffset = time_offset
+      IF( PRESENT( koffset ) )   joffset = koffset
       !
-      IF( PRESENT( kit ) )   THEN
-         zt = zt + ( kit +  joffset - 1 ) * rdt / REAL( nn_baro, wp )
+      IF( PRESENT( kit ) .AND. PRESENT( kbaro ) )   THEN
+         zt = zt + ( kit + 0.5_wp * ( joffset - 1 ) ) * rdt / REAL( kbaro, wp )
       ELSE
          zt = zt + joffset * rdt
@@ -74,5 +74,5 @@
       IF( ln_tide_ramp ) THEN         ! linear increase if asked
          zt = ( kt - nit000 ) * rdt
-         IF( PRESENT( kit ) )   zt = zt + ( kit + joffset -1) * rdt / REAL( nn_baro, wp )
+         IF( PRESENT( kit ) .AND. PRESENT( kbaro ) )   zt = zt + kit * rdt / REAL( kbaro, wp )
          zramp = MIN(  MAX( zt / (rdttideramp*rday) , 0._wp ) , 1._wp  )
          pot_astro(:,:) = zramp * pot_astro(:,:)
@@ -86,8 +86,9 @@
   !!----------------------------------------------------------------------
 CONTAINS
-  SUBROUTINE upd_tide( kt, kit, time_offset )  ! Empty routine
+  SUBROUTINE upd_tide( kt, kit, kbaro, koffset )          ! Empty routine
     INTEGER, INTENT(in)           ::   kt      !  integer  arg, dummy routine
     INTEGER, INTENT(in), OPTIONAL ::   kit     !  optional arg, dummy routine
-    INTEGER, INTENT(in), OPTIONAL ::   time_offset !  optional arg, dummy routine
+    INTEGER, INTENT(in), OPTIONAL ::   kbaro   !  optional arg, dummy routine
+    INTEGER, INTENT(in), OPTIONAL ::   koffset !  optional arg, dummy routine
     WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt
   END SUBROUTINE upd_tide
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 10251)
@@ -92,6 +92,4 @@
       IF( .NOT. lk_agrif .OR. .NOT. ln_rstart) THEN
          IF( sol_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'solver_init : unable to allocate sol_oce arrays' )
-         gcx (:,:) = 0.e0
-         gcxb(:,:) = 0.e0
       ENDIF
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 10251)
@@ -849,5 +849,5 @@
 
 
-   FUNCTION sto_par_flt_fac( kpasses )
+   REAL(wp) FUNCTION sto_par_flt_fac( kpasses )
       !!----------------------------------------------------------------------
       !!                  ***  FUNCTION sto_par_flt_fac  ***
@@ -858,5 +858,4 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) :: kpasses
-      REAL(wp) :: sto_par_flt_fac
       !!
       INTEGER :: jpasses, ji, jj, jflti, jfltj
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 10251)
@@ -22,5 +22,4 @@
    !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module
    !!             -   ! 2014-09  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80
-   !!             -   ! 2015-06  (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF
    !!----------------------------------------------------------------------
 
@@ -992,5 +991,5 @@
 
 
-   SUBROUTINE  eos_fzp_2d( psal, ptf, pdep )
+   FUNCTION eos_fzp_2d( psal, pdep ) RESULT( ptf )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE eos_fzp  ***
@@ -1006,5 +1005,5 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu]
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius]
+      REAL(wp), DIMENSION(jpi,jpj)                          ::   ptf   ! freezing temperature [Celcius]
       !
       INTEGER  ::   ji, jj   ! dummy loop indices
@@ -1039,9 +1038,9 @@
          nstop = nstop + 1
          !
-      END SELECT      
-      !
-  END SUBROUTINE eos_fzp_2d
-
-  SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
+      END SELECT
+      !
+   END FUNCTION eos_fzp_2d
+
+  FUNCTION eos_fzp_0d( psal, pdep ) RESULT( ptf )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE eos_fzp  ***
@@ -1055,7 +1054,7 @@
       !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu]
-      REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m]
-      REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celcius]
+      REAL(wp), INTENT(in)           ::   psal   ! salinity   [psu]
+      REAL(wp), INTENT(in), OPTIONAL ::   pdep   ! depth      [m]
+      REAL(wp)                       ::   ptf   ! freezing temperature [Celcius]
       !
       REAL(wp) :: zs   ! local scalars
@@ -1087,5 +1086,5 @@
       END SELECT
       !
-   END SUBROUTINE eos_fzp_0d
+   END FUNCTION eos_fzp_0d
 
 
@@ -1241,6 +1240,5 @@
       IF(lwm) WRITE( numond, nameos )
       !
-      rau0        = 1020._wp                 !: volumic mass of reference     [kg/m3]
-!     rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
+      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
       rcp         = 3991.86795711963_wp      !: heat capacity     [J/K]
       !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 10251)
@@ -173,5 +173,5 @@
          END DO 
       END DO 
-      CALL eos_fzp( tsn(:,:,1,jp_sal), zfzp(:,:), zpres(:,:) )
+      zfzp(:,:) = eos_fzp( tsn(:,:,1,jp_sal), zpres(:,:) )
       DO jk = 1, jpk
          DO jj = 1, jpj
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 10251)
@@ -212,6 +212,5 @@
       CHARACTER(len=3) ::   cdtype
       REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn
-      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', &
-          &  kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
+      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
    END SUBROUTINE tra_adv_eiv
 #endif
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 10251)
@@ -100,8 +100,4 @@
          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
-! slwa unless you use l_trdtra too, the above switches off trend calculations for l_trdtrc
-         l_trd = .FALSE.
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
-!slwa
       !
       IF( l_trd )  THEN
@@ -330,5 +326,5 @@
       CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav )
       CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts )
-      CALL wrk_alloc( jpi, jpj, jpk, kjpt+1, ztrs )
+      CALL wrk_alloc( jpi, jpj, jpk, 3, ztrs )
       !
       IF( kt == kit000 )  THEN
@@ -568,5 +564,5 @@
       !
                    CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts )
-                   CALL wrk_dealloc( jpi, jpj, jpk, kjpt+1, ztrs )
+                   CALL wrk_dealloc( jpi, jpj, jpk, 3, ztrs )
                    CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav )
       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tradwl.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tradwl.F90	(revision 10250)
+++ 	(revision )
@@ -1,238 +1,0 @@
-MODULE tradwl
-   !!======================================================================
-   !!                       ***  MODULE  tradwl  ***
-   !! Ocean physics: solar radiation penetration in the top ocean levels
-   !!======================================================================
-   !! History :  POLCOMS  !  1996-10  (J. Holt)  Original code
-   !!   NEMO     3.2  !  2010-03  (E. O'Dea)  Import to Nemo for use in Shelf Model
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_dwl      : trend due to the solar radiation penetration
-   !!   tra_dwl_init : solar radiation penetration initialization
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE trc_oce         ! share SMS/Ocean variables
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! ocean active tracers trends 
-   USE in_out_manager  ! I/O manager
-   USE phycst          ! physical constants
-   USE prtctl          ! Print control
-   USE iom             ! I/O manager
-   USE fldread         ! read input fields
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_dwl        ! routine called by step.F90 (ln_tradwl=T)
-
-   !                                           !!* Namelist namtra_qsr: penetrative solar radiation
-   LOGICAL , PUBLIC ::   ln_tradwl  = .TRUE.    ! light absorption (dwl) flag
-   LOGICAL , PUBLIC ::   ln_vary_lambda  = .TRUE.    ! vary Lambda or not flag
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE tra_dwl( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_qsr  ***
-      !!
-      !! ** Purpose :   Compute the temperature trend due to the solar radiation
-      !!      penetration and add it to the general temperature trend.
-      !!
-      !! ** Method  : The profile of the solar radiation within the ocean is defined
-      !!
-      !!          Jason Holt Oct 96
-      !!
-      !!          Calculates change in temperature due to penetrating
-      !!          radiation, with cooling at the surface layer
-      !!
-      !!          rad=rad0*exp(lambda*z)
-      !!
-      !!       Heat input into box is between z=K and z=K+1 is RAD(K)-RAD(K+1)
-      !!
-      !!
-      !! ** Action  : - update ta with the penetrative solar radiation trend
-      !!              - save the trend in ttrd ('key_trdtra')
-      !!
-      !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
-      !!
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step
-      !!
-      INTEGER  ::   ji, jj, jk           ! dummy loop indices
-      INTEGER  ::   irgb                 ! temporary integers
-      REAL(wp) ::   zchl, zcoef, zsi0r   ! temporary scalars
-      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace
-      !!----------------------------------------------------------------------
-      !! HERE GO VARIABLES USED IN POLCOMS CLEAN UP LATER
-
-      integer i,j,k
-!      real*8 dtmp(n-1)
-      real*8 dtmp(jpkm1)
-      real*8 z1,z2,Rad0,Rad1,Rad2,rD,SurfOut,cp
-      logical first
-      save first
-      data first/.true./
-      !!--------------------------End of POLCOMS variables Note instead of using saves
-      !!--------------------------Could shift this into initial code
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_dwl : penetration of the surface solar radiation'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-         CALL tra_dwl_init
-         IF( .NOT.ln_tradwl )   RETURN
-      ENDIF
-
-      IF( l_trdtra ) THEN      ! Save ta and sa trends
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ztrds(:,:,:) = 0.e0
-      ENDIF
-!--------------------------------------------------------------------
-!  Set transmissivity
-!--------------------------------------------------------------------
-!
-!  Normal value
-!
-!---------------------------------------------------------------------------
-!
-!  Convert Heat fluxes to units used in POL subroutine dwl
-!
-!---------------------------------------------------------------------------
-      cp=3986.0d0
-
-    DO jj = 2, jpj
-         DO ji = fs_2, fs_jpim1
-           qsr(ji,jj)  = qsr(ji,jj)  * (r1_rau0_rcp)
-         ENDDO       !ji
-    ENDDO            !jj
-!--------------------------------------------------------------------------------
-      if ( first ) then
-        rlambda2(:,:) = 0.0
-        first=.false.
-           if ( ln_vary_lambda ) then
-!        do j=1,jesub    ! Original Polcoms style Loop
-!          do i=1,iesub  ! Original Polcoms style Loop
-
-        do jj=2,jpjm1
-          do ji = fs_2, fs_jpim1   ! vector opt.
-
-!            if(ipexb(i,j).ne. 0) then  (Mask, use Tmask instead)
-
-              rlambda2(ji,jj)=-0.033*log(hbatt(ji,jj))+0.2583    ! JIAs formula
-              rlambda2(ji,jj)=max(0.05,rlambda2(ji,jj))     ! limit in deep water
-          enddo ! ji
-        enddo ! jj
-      rlambda = 0.0
-       else
-      rLambda=0.154
-       endif ! If vary lambda
-      endif ! If first
-
-!      do j=1,jesub      ! Original Polcoms Style Loop
-!        do i=1,iesub    ! Original Polcoms Style Loop
-              do jk=2,jpk
-        DO jj=2,jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-
-!--------------------------------------------------------------------
-! Calculate change in temperature
-!--------------------------------------------------------------------
-!
-!        rad0 = hfl_in(i,j)   ! change hfl_in to qsr I assume
-
-               rad0 = qsr(ji,jj)
-                     rD = rLambda2(ji,jj)  +rLambda      !  Transmissivity to be used here
-!       if rlambda 0 then rlambda2 not zer and vica versa 
-
-                z2=gdepw_0(ji,jj,jk-1)    ! grid box is from z=z1 to z=z2
-                z1=gdepw_0(ji,jj,jk)
-
-                Rad2=Rad0*(exp(-z2*rD)) ! radiation entering box
-                Rad1=Rad0*(exp(-z1*rD)) ! radiation leaving box
-
-
-                dtmp(jk)=1.0/(e3t_0(ji,jj,jk))*(Rad2-Rad1) !change in temperature
-                tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + dtmp(jk)
-         enddo  ! ji
-         enddo  ! jj
-             enddo !jk
-
-
-      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         !CEODCALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt )
-      ENDIF
-      !                       ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
-      !
-   END SUBROUTINE tra_dwl
-
-
-   SUBROUTINE tra_dwl_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_dwl_init  ***
-      !!
-      !! ** Purpose :   Initialization for the penetrative solar radiation for Downwell routine
-      !!
-      !! ** Method  :   The profile of solar radiation within the ocean is set
-      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
-      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
-      !!      default values correspond to clear water (type I in Jerlov' 
-      !!      (1968) classification.
-      !!         called by tra_qsr at the first timestep (nit000)
-      !!
-      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
-      !!
-      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk            ! dummy loop indices
-      INTEGER  ::   ios                   ! Local integer output status for namelist read
-      INTEGER  ::   irgb, ierror          ! temporary integer
-      INTEGER  ::   ioptio, nqsr          ! temporary integer
-      REAL(wp) ::   zc0  , zc1            ! temporary scalars
-      REAL(wp) ::   zc2  , zc3  , zchl    !    -         -
-      REAL(wp) ::   zsi0r, zsi1r, zcoef   !    -         -
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr              ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0 , ze1 , ze2 , ze3 , zea   ! 3D workspace
-      !!
-      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
-      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
-      NAMELIST/namtra_dwl/  ln_tradwl, ln_vary_lambda
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )            ! Read Namelist namtra_dwl in reference namelist :
-      READ  ( numnam_ref, namtra_dwl, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
-      
-      REWIND( numnam_cfg )            ! Read Namelist namtra_dwl in configuration namelist :
-      READ  ( numnam_cfg, namtra_dwl, IOSTAT = ios, ERR = 902)
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
-      !
-      IF(lwp) THEN                ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_dwl_init : '
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_dwl : set the parameter of penetration'
-         WRITE(numout,*) '      Light penetration (T) or not (F)         ln_tradwl  = ', ln_tradwl
-         WRITE(numout,*) '      Vary Lambda  (T) or not (F))             ln_vary_lambda  = ', ln_vary_lambda
-      ENDIF
-
-   END SUBROUTINE tra_dwl_init
-
-   !!======================================================================
-END MODULE tradwl
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 10251)
@@ -28,5 +28,4 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE sbcrnf          ! river runoffs
-   USE sbcisf          ! ice shelf melting/freezing
    USE zdf_oce         ! ocean vertical mixing
    USE domvvl          ! variable volume
@@ -47,4 +46,5 @@
    USE timing          ! Timing
 #if defined key_agrif
+   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -58,5 +58,4 @@
 
    REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
-   INTEGER  ::   warn_1, warn_2   ! indicators for warning statement
 
    !! * Substitutions
@@ -94,6 +93,6 @@
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
-      INTEGER  ::   jk, jn, ji, jj     ! dummy loop indices
-      REAL(wp) ::   zfact, zfreeze     ! local scalars
+      INTEGER  ::   jk, jn    ! dummy loop indices
+      REAL(wp) ::   zfact     ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -111,13 +110,12 @@
       ! Update after tracer on domain lateral boundaries
       ! 
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
+      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
+      !
+#if defined key_bdy 
+      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
+#endif
 #if defined key_agrif
       CALL Agrif_tra                     ! AGRIF zoom boundaries
-#endif
-      !
-      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
-      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
-      !
-#if defined key_bdy 
-      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
 #endif
  
@@ -126,33 +124,4 @@
       ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
       ENDIF
-
-#if ( ! defined key_lim3 && ! defined key_lim2 && ! key_cice )
-      IF ( kt == nit000 ) warn_1=0
-      warn_2=0
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( tsa(ji,jj,jk,jp_tem) .lt. 0.0 ) THEN
-                  ! calculate freezing point
-                  zfreeze = ( -0.0575_wp + 1.710523E-3 * Sqrt(Abs(tsn(ji,jj,jk,jp_sal)))   & 
-                            - 2.154996E-4 * tsn(ji,jj,jk,jp_sal) ) * tsn(ji,jj,jk,jp_sal) - 7.53E-4 * ( 10.0_wp + fsdept(ji,jj,jk) )
-                  IF ( tsa(ji,jj,jk,jp_tem) .lt. zfreeze ) THEN
-                     tsa(ji,jj,jk,jp_tem)=zfreeze
-                     warn_2=1
-                  ENDIF
-               ENDIF
-            END DO
-         END DO
-      END DO
-      CALL mpp_max(warn_1)
-      CALL mpp_max(warn_2)
-      IF ( (warn_1 == 0) .and. (warn_2 /= 0) ) THEN
-         IF(lwp) THEN
-            CALL ctl_warn( ' Temperatures dropping below freezing point, ', &
-                      &    ' being forced to freezing point, no longer conservative' ) 
-         ENDIF
-         warn_1=1
-      ENDIF
-#endif
 
       ! trends computation initialisation
@@ -179,7 +148,12 @@
          ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
          ENDIF
-      ENDIF     
-      !
-     ! trends computation
+      ENDIF 
+      !
+#if defined key_agrif
+      ! Update tracer at AGRIF zoom boundaries
+      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
+#endif      
+      !
+      ! trends computation
       IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
          DO jk = 1, jpkm1
@@ -305,5 +279,5 @@
 
       !!     
-      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
+      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical
       INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
       REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
@@ -321,14 +295,8 @@
          ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
          ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
-         IF (nn_isf .GE. 1) THEN 
-            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
-         ELSE
-            ll_isf = .FALSE.
-         END IF
       ELSE                          
          ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
          ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
          ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
-         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
       ENDIF
       !
@@ -353,31 +321,15 @@
                   ztc_f  = ztc_n  + atfp * ztc_d
                   !
-                  IF( jk == mikt(ji,jj) ) THEN           ! first level 
-                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
-                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
-                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
+                  IF( jk == 1 ) THEN           ! first level 
+                     ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) + rnf(ji,jj) - rnf_b(ji,jj) )
                      ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
                   ENDIF
 
-                  ! solar penetration (temperature only)
-                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
+                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
                      &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
 
-                  ! river runoff
-                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
+                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   & 		      ! river runoffs
                      &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
                      &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
-
-                  ! ice shelf
-                  IF( ll_isf ) THEN
-                     ! level fully include in the Losch_2008 ice shelf boundary layer
-                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
-                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
-                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
-                     ! level partially include in Losch_2008 ice shelf boundary layer 
-                     IF ( jk == misfkb(ji,jj) )                                                   &
-                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
-                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
-                  END IF
 
                   ze3t_f = 1.e0 / ze3t_f
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 10251)
@@ -46,5 +46,4 @@
    LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem)
    INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0)
-   INTEGER , PUBLIC ::   nn_kd490dta  !: use kd490dta data (=1) or not (=0)
    REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands)
    REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
@@ -55,5 +54,4 @@
    REAL(wp) ::   xsi1r                           !: inverse of rn_si1
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_kd490 ! structure of input kd490 (file informations, fields read)
    INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m)
    REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption
@@ -308,48 +306,4 @@
             !
          ENDIF
-! slwa
-         IF( nn_kd490dta == 1 ) THEN                      !  use KD490 data read in   !
-            !                                             ! ------------------------- !
-               nksr = jpk - 1
-               !
-               CALL fld_read( kt, 1, sf_kd490 )     ! Read kd490 data and provide it at the current time step
-               !
-               zcoef  = ( 1. - rn_abs )
-               ze0(:,:,1) = rn_abs  * qsr(:,:)
-               ze1(:,:,1) = zcoef * qsr(:,:)
-               zea(:,:,1) =         qsr(:,:)
-               !
-               DO jk = 2, nksr+1
-!CDIR NOVERRCHK
-                  DO jj = 1, jpj
-!CDIR NOVERRCHK   
-                     DO ji = 1, jpi
-                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     )
-                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * sf_kd490(1)%fnow(ji,jj,1) )
-                        ze0(ji,jj,jk) = zc0
-                        ze1(ji,jj,jk) = zc1
-                        zea(ji,jj,jk) = ( zc0 + zc1 ) * tmask(ji,jj,jk)
-                     END DO
-                  END DO
-               END DO
-               ! clem: store attenuation coefficient of the first ocean level
-               IF ( ln_qsr_ice ) THEN
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     )
-                        zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * sf_kd490(1)%fnow(ji,jj,1) )
-                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 ) * tmask(ji,jj,2) 
-                     END DO
-                  END DO
-               ENDIF
-               !
-               DO jk = 1, nksr                                        ! compute and add qsr trend to ta
-                  qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) )
-               END DO
-               zea(:,:,nksr+1:jpk) = 0.e0     ! 
-               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution
-               !
-        ENDIF   ! use KD490 data
-!slwa
          !
          !                                        Add to the general trend
@@ -420,8 +374,7 @@
       CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
       TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
-      TYPE(FLD_N)        ::   sn_kd490 ! informations about the kd490 field to be read
-      !!
-      NAMELIST/namtra_qsr/  sn_chl, sn_kd490, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
-         &                  nn_chldta, rn_abs, rn_si0, rn_si1, nn_kd490dta
+      !!
+      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
+         &                  nn_chldta, rn_abs, rn_si0, rn_si1
       !!----------------------------------------------------------------------
 
@@ -456,5 +409,4 @@
          WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0
          WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1
-         WRITE(numout,*) '      read in KD490 data                       nn_kd490dta  = ', nn_kd490dta
       ENDIF
 
@@ -470,5 +422,4 @@
          IF( ln_qsr_2bd  )   ioptio = ioptio + 1
          IF( ln_qsr_bio  )   ioptio = ioptio + 1
-         IF( nn_kd490dta == 1 )   ioptio = ioptio + 1
          !
          IF( ioptio /= 1 ) &
@@ -480,5 +431,4 @@
          IF( ln_qsr_2bd                      )   nqsr =  3
          IF( ln_qsr_bio                      )   nqsr =  4
-         IF( nn_kd490dta == 1                )   nqsr =  5
          !
          IF(lwp) THEN                   ! Print the choice
@@ -488,5 +438,4 @@
             IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration'
             IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration'
-            IF( nqsr ==  5 )   WRITE(numout,*) '         KD490 light penetration'
          ENDIF
          !
@@ -498,18 +447,6 @@
          xsi0r = 1.e0 / rn_si0
          xsi1r = 1.e0 / rn_si1
-         IF( nn_kd490dta == 1 ) THEN           !* KD490 data : set sf_kd490 structure
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '        KD490 read in a file'
-            ALLOCATE( sf_kd490(1), STAT=ierror )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_kd490 structure' )   ;   RETURN
-            ENDIF
-            ALLOCATE( sf_kd490(1)%fnow(jpi,jpj,1)   )
-            IF( sn_kd490%ln_tint )ALLOCATE( sf_kd490(1)%fdta(jpi,jpj,1,2) )
-            !                                        ! fill sf_kd490 with sn_kd490 and control print
-            CALL fld_fill( sf_kd490, (/ sn_kd490 /), cn_dir, 'tra_qsr_init',   &
-               &                                         'Solar penetration function of read KD490', 'namtra_qsr' )
          !                                ! ---------------------------------- !
-         ELSEIF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  !
+         IF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  !
             !                             ! ---------------------------------- !
             !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 10251)
@@ -25,5 +25,4 @@
    USE trd_oce         ! trends: ocean variables
    USE trdtra          ! trends manager: tracers 
-   USE tradwl          ! solar radiation penetration (downwell method)
    !
    USE in_out_manager  ! I/O manager
@@ -34,7 +33,4 @@
    USE timing          ! Timing
    USE eosbn2
-#if defined key_asminc   
-   USE asminc          ! Assimilation increment
-#endif
 
    IMPLICIT NONE
@@ -124,4 +120,5 @@
       REAL(wp) ::   zfact, z1_e3t, zdep
       REAL(wp) ::   zalpha, zhk
+      REAL(wp) ::  zt_frz, zpress
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -142,5 +139,5 @@
 
 !!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
-      IF( .NOT.ln_traqsr .and. .NOT.ln_tradwl ) THEN     ! no solar radiation penetration
+      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
          qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
          qsr(:,:) = 0.e0                     ! qsr set to zero
@@ -235,7 +232,11 @@
                DO jk = ikt, ikb - 1
                ! compute tfreez for the temperature correction (we add water at freezing temperature)
+!                  zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04
+                  zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )
                ! compute trend
                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                          &
-                     &           + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj)
+                     &           + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)          &
+                     &               - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) &
+                     &           * r1_hisf_tbl(ji,jj)
                   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                          &
                      &           + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj)
@@ -244,7 +245,11 @@
                ! level partially include in ice shelf boundary layer 
                ! compute tfreez for the temperature correction (we add water at freezing temperature)
+!               zpress = grav*rau0*fsdept(ji,jj,ikb)*1.e-04
+               zt_frz = -1.9 !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress )
                ! compute trend
                tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                           &
-                  &              + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
+                  &              + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)          &
+                  &                  - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 
+                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
                tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal)                                           &
                   &              + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 
@@ -282,23 +287,4 @@
          END DO  
       ENDIF
-
-#if defined key_asminc
-! WARNING: THIS MAY WELL NOT BE REQUIRED - WE DON'T WANT TO CHANGE T&S BUT THIS MAY COMPENSATE ANOTHER TERM...
-! Rate of change in e3t for each level is ssh_iau*e3t_0/ht_0
-! Contribution to tsa should be rate of change in level / per m of ocean? (hence the division by fse3t_n)
-      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation
-         DO jj = 2, jpj 
-            DO ji = fs_2, fs_jpim1
-               zdep = ssh_iau(ji,jj) / ( ht_0(ji,jj) + 1.0 - ssmask(ji, jj) )
-               DO jk = 1, jpkm1
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
-                                        &            + tsn(ji,jj,jk,jp_tem) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) )
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
-                                        &            + tsn(ji,jj,jk,jp_sal) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) )
-               END DO
-            END DO  
-         END DO  
-      ENDIF
-#endif
  
       IF( l_trdtra )   THEN                      ! send trends for further diagnostics
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 10251)
@@ -117,28 +117,28 @@
       !
       SELECT CASE( ktrd )
-        CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient
-        CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient
-        CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit)
-        CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter)
-        CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity
-        CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term)
-        CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had)
-        CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection
-        CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion
-        CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion 
+      	CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient
+      	CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient
+      	CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit)
+      	CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter)
+      	CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity
+      	CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term)
+      	CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had)
+      	CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection
+      	CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion
+      	CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion 
                                  !                                   ! wind stress trends
-                                CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
-                     z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1)
-                     z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1)
-                     zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
-                     DO jj = 2, jpj
-                         DO ji = 2, jpi
-                           zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
-                            &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
-                         END DO
-                     END DO
-                                CALL iom_put( "ketrd_tau", zke2d )
-                                CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
-        CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case) 
+                              	CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
+         						z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1)
+         						z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1)
+         						zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
+         						DO jj = 2, jpj
+            					   DO ji = 2, jpi
+               						zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
+                  					&                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
+            					   END DO
+         						END DO
+                              	CALL iom_put( "ketrd_tau", zke2d )
+                              	CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
+      	CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case) 
 !!gm TO BE DONE properly
 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation....
@@ -162,5 +162,5 @@
 !         ENDIF
 !!gm end
-        CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends 
+      	CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends 
 !! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!!
 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf....
@@ -184,12 +184,12 @@
 !                              CALL iom_put( "ketrd_bfri", zke2d )
 !         ENDIF
-        CASE( jpdyn_ken )   ;   ! kinetic energy
-                    ! called in dynnxt.F90 before asselin time filter
-                    ! with putrd=ua and pvtrd=va
-                    zke(:,:,:) = 0.5_wp * zke(:,:,:)
-                    CALL iom_put( "KE", zke )
-                    !
-                    CALL ken_p2k( kt , zke )
-                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
+      	CASE( jpdyn_ken )   ;   ! kinetic energy
+      							! called in dynnxt.F90 before asselin time filter
+      							! with putrd=ua and pvtrd=va
+      							zke(:,:,:) = 0.5_wp * zke(:,:,:)
+      							CALL iom_put( "KE", zke )
+      							!
+      							CALL ken_p2k( kt , zke )
+            					CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
          !
       END SELECT
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 10251)
@@ -165,11 +165,11 @@
 
 
-      SELECT CASE( ktrd )
-      CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
+		SELECT CASE( ktrd )
+		CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
 !!gm : to be completed ! 
-!         IF( ....
+!		   IF( ....
 !!gm end
-      CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
-         !                                   ! regroup iso-neutral diffusion in one term
+		CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
+		   !                                   ! regroup iso-neutral diffusion in one term
          tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) )
          smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) )
@@ -811,5 +811,5 @@
 
 
-      nkstp     = nit000 - 1              ! current time step indicator initialization
+   	nkstp     = nit000 - 1              ! current time step indicator initialization
 
 
@@ -851,5 +851,5 @@
       IF( nn_ctls == 1 ) THEN
          CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-         READ ( inum, * ) nbol
+         READ ( inum ) nbol
          CLOSE( inum )
       END IF
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 10251)
@@ -15,5 +15,5 @@
 
    !                                                !* mixed layer trend indices
-   INTEGER, PUBLIC, PARAMETER ::   jpltrd = 12      !: number of mixed-layer trends arrays
+   INTEGER, PUBLIC, PARAMETER ::   jpltrd = 11      !: number of mixed-layer trends arrays
    INTEGER, PUBLIC            ::   jpktrd           !: max level for mixed-layer trends diag.
    !
@@ -28,6 +28,6 @@
    INTEGER, PUBLIC, PARAMETER ::   jpmxl_for =  9   !: forcing 
    INTEGER, PUBLIC, PARAMETER ::   jpmxl_dmp = 10   !: internal restoring trend
-   INTEGER, PUBLIC, PARAMETER ::   jpmxl_zdfp = 11  !: iso-neutral diffusion:"pure" vertical diffusion
-   INTEGER, PUBLIC, PARAMETER ::   jpmxl_atf  = 12  !: asselin trend (**MUST BE THE LAST ONE**)
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_zdfp = 11   !: asselin trend (**MUST BE THE LAST ONE**)
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_atf  = 12   !: asselin trend (**MUST BE THE LAST ONE**)
    !                                                            !!* Namelist namtrd_mxl:  trend diagnostics in the mixed layer *
    INTEGER           , PUBLIC ::   nn_ctls  = 0                  !: control surface type for trends vertical integration
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 10251)
@@ -99,7 +99,7 @@
                                    CALL wrk_alloc( jpi, jpj, z2d )
                                    z2d(:,:) = wn(:,:,1) * ( &
-                                       &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
-                                       &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
-                                       &             ) / fse3t(:,:,1)
+                                   	  &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
+                                   	  &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
+                                      &   					) / fse3t(:,:,1)
                                    CALL iom_put( "petrd_sad" , z2d )
                                    CALL wrk_dealloc( jpi, jpj, z2d )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 10251)
@@ -203,12 +203,7 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_tracer_budget
-!              ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)  )  * tmask(ji,jj,jk)
-               ptrd(ji,jj,jk) = -      pf (ji,jj,jk) * tmask(ji,jj,jk)
-#else
                ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        &
                  &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   &
                  &              / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )  * tmask(ji,jj,jk)
-#endif
             END DO
          END DO
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 10251)
@@ -18,5 +18,4 @@
    USE phycst          ! physical constants
    USE iom             ! I/O library
-   USE eosbn2          ! for zdf_mxl_zint
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! work arrays
@@ -27,37 +26,13 @@
    PRIVATE
 
-   PUBLIC   zdf_mxl_tref  ! called by asminc.F90
    PUBLIC   zdf_mxl       ! called by step.F90
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld_tref  !: mixed layer depth at t-points - temperature criterion [m]
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m]
-   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:,:) ::   hmld_zint  !: vertically-interpolated mixed layer depth   [m] 
-   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:,:) ::   htc_mld    ! Heat content of hmld_zint
-   LOGICAL, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    :: ll_found   ! Is T_b to be found by interpolation ? 
-   LOGICAL, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: ll_belowml ! Flag points below mixed layer when ll_found=F
 
    REAL(wp), PUBLIC ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth
    REAL(wp)         ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
-
-   TYPE, PUBLIC :: MXL_ZINT   !: Structure for MLD defs
-      INTEGER   :: mld_type   ! mixed layer type     
-      REAL(wp)  :: zref       ! depth of initial T_ref
-      REAL(wp)  :: dT_crit    ! Critical temp diff
-      REAL(wp)  :: iso_frac   ! Fraction of rn_dT_crit used
-   END TYPE MXL_ZINT
-
-!Used for 25h mean
-   LOGICAL, PRIVATE :: mld_25h_init = .TRUE.    !Logical used to initalise 25h
-                                                !outputs. Necassary, because we need to
-                                                !initalise the mld_25h on the zeroth
-                                                !timestep (i.e in the nemogcm_init call)
-   LOGICAL, PRIVATE :: mld_25h_write = .FALSE.  !Logical confirm 25h calculating/processing
-
-   INTEGER, SAVE :: i_cnt_25h                   ! Counter for 25 hour means
-
-   REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   hmld_zint_25h
 
    !! * Substitutions
@@ -76,9 +51,6 @@
       zdf_mxl_alloc = 0      ! set to zero if no array to be allocated
       IF( .NOT. ALLOCATED( nmln ) ) THEN
-         ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), hmld_zint(jpi,jpj),       &
-        &          htc_mld(jpi,jpj),                                                                    &
-        &          ll_found(jpi,jpj), ll_belowml(jpi,jpj,jpk), STAT= zdf_mxl_alloc )
+         ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc )
          !
-         ALLOCATE(hmld_tref(jpi,jpj))
          IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc )
          IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.')
@@ -87,46 +59,4 @@
    END FUNCTION zdf_mxl_alloc
 
-   SUBROUTINE zdf_mxl_tref() 
-      !!---------------------------------------------------------------------- 
-      !!                  ***  ROUTINE zdf_mxl_tref  *** 
-      !!                    
-      !! ** Purpose :   Compute the mixed layer depth with temperature criteria. 
-      !! 
-      !! ** Method  :   The temperature-defined mixed layer depth is required 
-      !!                   when assimilating SST in a 2D analysis.  
-      !! 
-      !! ** Action  :   hmld_tref 
-      !!---------------------------------------------------------------------- 
-      ! 
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
-      REAL(wp) ::   t_ref               ! Reference temperature   
-      REAL(wp) ::   temp_c = 0.2        ! temperature criterion for mixed layer depth   
-      !!---------------------------------------------------------------------- 
-      ! 
-      ! Initialise array 
-      IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl_tref : unable to allocate arrays' ) 
-       
-      !For the AMM model assimiation uses a temperature based mixed layer depth   
-      !This is defined here   
-      DO jj = 1, jpj   
-         DO ji = 1, jpi   
-           hmld_tref(ji,jj)=fsdept(ji,jj,1  )    
-           IF(ssmask(ji,jj) > 0.)THEN   
-             t_ref=tsn(ji,jj,1,jp_tem)  
-             DO jk=2,jpk   
-               IF(ssmask(ji,jj)==0.)THEN   
-                  hmld_tref(ji,jj)=fsdept(ji,jj,jk )   
-                  EXIT   
-               ELSEIF( ABS(tsn(ji,jj,jk,jp_tem)-t_ref) < temp_c)THEN   
-                  hmld_tref(ji,jj)=fsdept(ji,jj,jk )   
-               ELSE   
-                  EXIT   
-               ENDIF   
-             ENDDO   
-           ENDIF   
-         ENDDO   
-      ENDDO 
-   
-   END SUBROUTINE zdf_mxl_tref 
 
    SUBROUTINE zdf_mxl( kt )
@@ -207,7 +137,4 @@
       ENDIF
       
-      ! Vertically-interpolated mixed-layer depth diagnostic
-      CALL zdf_mxl_zint( kt )
-
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
       !
@@ -218,392 +145,4 @@
    END SUBROUTINE zdf_mxl
 
-   SUBROUTINE zdf_mxl_zint_mld( sf ) 
-      !!---------------------------------------------------------------------------------- 
-      !!                    ***  ROUTINE zdf_mxl_zint_mld  *** 
-      !                                                                        
-      !   Calculate vertically-interpolated mixed layer depth diagnostic. 
-      !            
-      !   This routine can calculate the mixed layer depth diagnostic suggested by
-      !   Kara et al, 2000, JGR, 105, 16803, but is more general and can calculate
-      !   vertically-interpolated mixed-layer depth diagnostics with other parameter
-      !   settings set in the namzdf_mldzint namelist.  
-      ! 
-      !   If mld_type=1 the mixed layer depth is calculated as the depth at which the  
-      !   density has increased by an amount equivalent to a temperature difference of  
-      !   0.8C at the surface. 
-      ! 
-      !   For other values of mld_type the mixed layer is calculated as the depth at  
-      !   which the temperature differs by 0.8C from the surface temperature.  
-      !                                                                        
-      !   David Acreman, Daley Calvert                                      
-      ! 
-      !!----------------------------------------------------------------------------------- 
-
-      TYPE(MXL_ZINT), INTENT(in)  :: sf
-
-      ! Diagnostic criteria
-      INTEGER   :: nn_mld_type   ! mixed layer type     
-      REAL(wp)  :: rn_zref       ! depth of initial T_ref
-      REAL(wp)  :: rn_dT_crit    ! Critical temp diff
-      REAL(wp)  :: rn_iso_frac   ! Fraction of rn_dT_crit used
-
-      ! Local variables
-      REAL(wp), PARAMETER :: zepsilon = 1.e-30          ! local small value
-      INTEGER, POINTER, DIMENSION(:,:) :: ikmt          ! number of active tracer levels 
-      INTEGER, POINTER, DIMENSION(:,:) :: ik_ref        ! index of reference level 
-      INTEGER, POINTER, DIMENSION(:,:) :: ik_iso        ! index of last uniform temp level 
-      REAL, POINTER, DIMENSION(:,:,:)  :: zT            ! Temperature or density 
-      REAL, POINTER, DIMENSION(:,:)    :: ppzdep        ! depth for use in calculating d(rho) 
-      REAL, POINTER, DIMENSION(:,:)    :: zT_ref        ! reference temperature 
-      REAL    :: zT_b                                   ! base temperature 
-      REAL, POINTER, DIMENSION(:,:,:)  :: zdTdz         ! gradient of zT 
-      REAL, POINTER, DIMENSION(:,:,:)  :: zmoddT        ! Absolute temperature difference 
-      REAL    :: zdz                                    ! depth difference 
-      REAL    :: zdT                                    ! temperature difference 
-      REAL, POINTER, DIMENSION(:,:)    :: zdelta_T      ! difference critereon 
-      REAL, POINTER, DIMENSION(:,:)    :: zRHO1, zRHO2  ! Densities 
-      INTEGER :: ji, jj, jk                             ! loop counter 
-
-      !!------------------------------------------------------------------------------------- 
-      !  
-      CALL wrk_alloc( jpi, jpj, ikmt, ik_ref, ik_iso) 
-      CALL wrk_alloc( jpi, jpj, ppzdep, zT_ref, zdelta_T, zRHO1, zRHO2 ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zT, zdTdz, zmoddT ) 
-
-      ! Unpack structure
-      nn_mld_type = sf%mld_type
-      rn_zref     = sf%zref
-      rn_dT_crit  = sf%dT_crit
-      rn_iso_frac = sf%iso_frac
-
-      ! Set the mixed layer depth criterion at each grid point 
-      IF( nn_mld_type == 0 ) THEN
-         zdelta_T(:,:) = rn_dT_crit
-         zT(:,:,:) = rhop(:,:,:)
-      ELSE IF( nn_mld_type == 1 ) THEN
-         ppzdep(:,:)=0.0 
-         call eos ( tsn(:,:,1,:), ppzdep(:,:), zRHO1(:,:) ) 
-! Use zT temporarily as a copy of tsn with rn_dT_crit added to SST 
-! [assumes number of tracers less than number of vertical levels] 
-         zT(:,:,1:jpts)=tsn(:,:,1,1:jpts) 
-         zT(:,:,jp_tem)=zT(:,:,1)+rn_dT_crit 
-         CALL eos( zT(:,:,1:jpts), ppzdep(:,:), zRHO2(:,:) ) 
-         zdelta_T(:,:) = abs( zRHO1(:,:) - zRHO2(:,:) ) * rau0 
-         ! RHO from eos (2d version) doesn't calculate north or east halo: 
-         CALL lbc_lnk( zdelta_T, 'T', 1. ) 
-         zT(:,:,:) = rhop(:,:,:) 
-      ELSE 
-         zdelta_T(:,:) = rn_dT_crit                      
-         zT(:,:,:) = tsn(:,:,:,jp_tem)                           
-      END IF 
-
-      ! Calculate the gradient of zT and absolute difference for use later 
-      DO jk = 1 ,jpk-2 
-         zdTdz(:,:,jk)  =    ( zT(:,:,jk+1) - zT(:,:,jk) ) / fse3w(:,:,jk+1) 
-         zmoddT(:,:,jk) = abs( zT(:,:,jk+1) - zT(:,:,jk) ) 
-      END DO 
-
-      ! Find density/temperature at the reference level (Kara et al use 10m).          
-      ! ik_ref is the index of the box centre immediately above or at the reference level 
-      ! Find rn_zref in the array of model level depths and find the ref    
-      ! density/temperature by linear interpolation.                                   
-      DO jk = jpkm1, 2, -1 
-         WHERE ( fsdept(:,:,jk) > rn_zref ) 
-           ik_ref(:,:) = jk - 1 
-           zT_ref(:,:) = zT(:,:,jk-1) + zdTdz(:,:,jk-1) * ( rn_zref - fsdept(:,:,jk-1) ) 
-         END WHERE 
-      END DO 
-
-      ! If the first grid box centre is below the reference level then use the 
-      ! top model level to get zT_ref 
-      WHERE ( fsdept(:,:,1) > rn_zref )  
-         zT_ref = zT(:,:,1) 
-         ik_ref = 1 
-      END WHERE 
-
-      ! The number of active tracer levels is 1 less than the number of active w levels 
-      ikmt(:,:) = mbathy(:,:) - 1 
-
-      ! Initialize / reset
-      ll_found(:,:) = .false.
-
-      IF ( rn_iso_frac - zepsilon > 0. ) THEN
-         ! Search for a uniform density/temperature region where adjacent levels          
-         ! differ by less than rn_iso_frac * deltaT.                                      
-         ! ik_iso is the index of the last level in the uniform layer  
-         ! ll_found indicates whether the mixed layer depth can be found by interpolation 
-         ik_iso(:,:)   = ik_ref(:,:) 
-         DO jj = 1, nlcj 
-            DO ji = 1, nlci 
-!CDIR NOVECTOR 
-               DO jk = ik_ref(ji,jj), ikmt(ji,jj)-1 
-                  IF ( zmoddT(ji,jj,jk) > ( rn_iso_frac * zdelta_T(ji,jj) ) ) THEN 
-                     ik_iso(ji,jj)   = jk 
-                     ll_found(ji,jj) = ( zmoddT(ji,jj,jk) > zdelta_T(ji,jj) ) 
-                     EXIT 
-                  END IF 
-               END DO 
-            END DO 
-         END DO 
-
-         ! Use linear interpolation to find depth of mixed layer base where possible 
-         hmld_zint(:,:) = rn_zref 
-         DO jj = 1, jpj 
-            DO ji = 1, jpi 
-               IF (ll_found(ji,jj) .and. tmask(ji,jj,1) == 1.0) THEN 
-                  zdz =  abs( zdelta_T(ji,jj) / zdTdz(ji,jj,ik_iso(ji,jj)) ) 
-                  hmld_zint(ji,jj) = fsdept(ji,jj,ik_iso(ji,jj)) + zdz 
-               END IF 
-            END DO 
-         END DO 
-      END IF
-
-      ! If ll_found = .false. then calculate MLD using difference of zdelta_T    
-      ! from the reference density/temperature 
- 
-! Prevent this section from working on land points 
-      WHERE ( tmask(:,:,1) /= 1.0 ) 
-         ll_found = .true. 
-      END WHERE 
- 
-      DO jk=1, jpk 
-         ll_belowml(:,:,jk) = abs( zT(:,:,jk) - zT_ref(:,:) ) >= zdelta_T(:,:)  
-      END DO 
- 
-! Set default value where interpolation cannot be used (ll_found=false)  
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-            IF ( .not. ll_found(ji,jj) )  hmld_zint(ji,jj) = fsdept(ji,jj,ikmt(ji,jj)) 
-         END DO 
-      END DO 
-
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-!CDIR NOVECTOR 
-            DO jk = ik_ref(ji,jj)+1, ikmt(ji,jj) 
-               IF ( ll_found(ji,jj) ) EXIT 
-               IF ( ll_belowml(ji,jj,jk) ) THEN                
-                  zT_b = zT_ref(ji,jj) + zdelta_T(ji,jj) * SIGN(1.0, zdTdz(ji,jj,jk-1) ) 
-                  zdT  = zT_b - zT(ji,jj,jk-1)                                      
-                  zdz  = zdT / zdTdz(ji,jj,jk-1)                                       
-                  hmld_zint(ji,jj) = fsdept(ji,jj,jk-1) + zdz 
-                  EXIT                                                   
-               END IF 
-            END DO 
-         END DO 
-      END DO 
-
-      hmld_zint(:,:) = hmld_zint(:,:)*tmask(:,:,1) 
-      !  
-      CALL wrk_dealloc( jpi, jpj, ikmt, ik_ref, ik_iso) 
-      CALL wrk_dealloc( jpi, jpj, ppzdep, zT_ref, zdelta_T, zRHO1, zRHO2 ) 
-      CALL wrk_dealloc( jpi,jpj, jpk, zT, zdTdz, zmoddT ) 
-      ! 
-   END SUBROUTINE zdf_mxl_zint_mld
-
-   SUBROUTINE zdf_mxl_zint_htc( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE zdf_mxl_zint_htc  ***
-      !! 
-      !! ** Purpose :   
-      !!
-      !! ** Method  :   
-      !!----------------------------------------------------------------------
-
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-
-      INTEGER :: ji, jj, jk
-      INTEGER :: ikmax
-      REAL(wp) :: zc, zcoef
-      !
-      INTEGER,  ALLOCATABLE, DIMENSION(:,:) ::   ilevel
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zthick_0, zthick
-
-      !!----------------------------------------------------------------------
-
-      IF( .NOT. ALLOCATED(ilevel) ) THEN
-         ALLOCATE( ilevel(jpi,jpj), zthick_0(jpi,jpj), &
-         &         zthick(jpi,jpj), STAT=ji )
-         IF( lk_mpp  )   CALL mpp_sum(ji)
-         IF( ji /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl_zint_htc : unable to allocate arrays' )
-      ENDIF
-
-      ! Find last whole model T level above the MLD
-      ilevel(:,:)   = 0
-      zthick_0(:,:) = 0._wp
-
-      DO jk = 1, jpkm1  
-         DO jj = 1, jpj
-            DO ji = 1, jpi                    
-               zthick_0(ji,jj) = zthick_0(ji,jj) + fse3t(ji,jj,jk)
-               IF( zthick_0(ji,jj) < hmld_zint(ji,jj) )   ilevel(ji,jj) = jk
-            END DO
-         END DO
-         WRITE(numout,*) 'zthick_0(jk =',jk,') =',zthick_0(2,2)
-         WRITE(numout,*) 'fsdepw(jk+1 =',jk+1,') =',fsdepw(2,2,jk+1)
-      END DO
-
-      ! Surface boundary condition
-      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc_mld(:,:) = 0._wp                                   
-      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc_mld(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)   
-      ENDIF
-
-      ! Deepest whole T level above the MLD
-      ikmax = MIN( MAXVAL( ilevel(:,:) ), jpkm1 )
-
-      ! Integration down to last whole model T level
-      DO jk = 1, ikmax
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zc = fse3t(ji,jj,jk) * REAL( MIN( MAX( 0, ilevel(ji,jj) - jk + 1 ) , 1  )  )    ! 0 below ilevel
-               zthick(ji,jj) = zthick(ji,jj) + zc
-               htc_mld(ji,jj) = htc_mld(ji,jj) + zc * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Subsequent partial T level
-      zthick(:,:) = hmld_zint(:,:) - zthick(:,:)   !   remaining thickness to reach MLD
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            htc_mld(ji,jj) = htc_mld(ji,jj) + tsn(ji,jj,ilevel(ji,jj)+1,jp_tem)  & 
-      &                      * MIN( fse3t(ji,jj,ilevel(ji,jj)+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel(ji,jj)+1)
-         END DO
-      END DO
-
-      WRITE(numout,*) 'htc_mld(after) =',htc_mld(2,2)
-
-      ! Convert to heat content
-      zcoef = rau0 * rcp
-      htc_mld(:,:) = zcoef * htc_mld(:,:)
-
-   END SUBROUTINE zdf_mxl_zint_htc
-
-   SUBROUTINE zdf_mxl_zint( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE zdf_mxl_zint  ***
-      !! 
-      !! ** Purpose :   
-      !!
-      !! ** Method  :   
-      !!----------------------------------------------------------------------
-
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-
-      INTEGER :: ios
-      INTEGER :: jn
-
-      INTEGER :: nn_mld_diag = 0    ! number of diagnostics
-
-      INTEGER :: i_steps          ! no of timesteps per hour
-      INTEGER :: ierror             ! logical error message   
-
-      REAL(wp) :: zdt             ! timestep variable  
-
-      CHARACTER(len=1) :: cmld
-
-      TYPE(MXL_ZINT) :: sn_mld1, sn_mld2, sn_mld3, sn_mld4, sn_mld5
-      TYPE(MXL_ZINT), SAVE, DIMENSION(5) ::   mld_diags
-
-      NAMELIST/namzdf_mldzint/ nn_mld_diag, sn_mld1, sn_mld2, sn_mld3, sn_mld4, sn_mld5
-
-      !!----------------------------------------------------------------------
-      
-      IF( kt == nit000 ) THEN
-         REWIND( numnam_ref )              ! Namelist namzdf_mldzint in reference namelist 
-         READ  ( numnam_ref, namzdf_mldzint, IOSTAT = ios, ERR = 901)
-901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_mldzint in reference namelist', lwp )
-
-         REWIND( numnam_cfg )              ! Namelist namzdf_mldzint in configuration namelist 
-         READ  ( numnam_cfg, namzdf_mldzint, IOSTAT = ios, ERR = 902 )
-902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_mldzint in configuration namelist', lwp )
-         IF(lwm) WRITE ( numond, namzdf_mldzint )
-
-         IF( nn_mld_diag > 5 )   CALL ctl_stop( 'STOP', 'zdf_mxl_ini: Specify no more than 5 MLD definitions' )
-
-         mld_diags(1) = sn_mld1
-         mld_diags(2) = sn_mld2
-         mld_diags(3) = sn_mld3
-         mld_diags(4) = sn_mld4
-         mld_diags(5) = sn_mld5
-
-         IF( nn_mld_diag > 0 ) THEN
-            WRITE(numout,*) '=============== Vertically-interpolated mixed layer ================'
-            WRITE(numout,*) '(Diagnostic number, nn_mld_type, rn_zref, rn_dT_crit, rn_iso_frac)'
-            DO jn = 1, nn_mld_diag
-               WRITE(numout,*) 'MLD criterion',jn,':'
-               WRITE(numout,*) '    nn_mld_type =', mld_diags(jn)%mld_type
-               WRITE(numout,*) '    rn_zref ='    , mld_diags(jn)%zref
-               WRITE(numout,*) '    rn_dT_crit =' , mld_diags(jn)%dT_crit
-               WRITE(numout,*) '    rn_iso_frac =', mld_diags(jn)%iso_frac
-            END DO
-            WRITE(numout,*) '===================================================================='
-         ENDIF
-      ENDIF
-
-      IF( nn_mld_diag > 0 ) THEN
-         DO jn = 1, nn_mld_diag
-            WRITE(cmld,'(I1)') jn
-            IF( iom_use( "mldzint_"//cmld ) .OR. iom_use( "mldhtc_"//cmld ) ) THEN
-               CALL zdf_mxl_zint_mld( mld_diags(jn) )
-
-               IF( iom_use( "mldzint_"//cmld ) ) THEN
-                  CALL iom_put( "mldzint_"//cmld, hmld_zint(:,:) )
-               ENDIF
-
-               IF( iom_use( "mldhtc_"//cmld ) )  THEN
-                  CALL zdf_mxl_zint_htc( kt )
-                  CALL iom_put( "mldhtc_"//cmld , htc_mld(:,:)   )
-               ENDIF
-
-               IF( iom_use( "mldzint25h_"//cmld ) ) THEN
-                  IF( .NOT. mld_25h_write ) mld_25h_write = .TRUE.
-                  zdt = rdt
-                  IF( nacc == 1 ) zdt = rdtmin
-                  IF( MOD( 3600,INT(zdt) ) == 0 ) THEN
-                     i_steps = 3600/INT(zdt)
-                  ELSE
-                     CALL ctl_stop('STOP', 'zdf_mxl_zint 25h: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible')
-                  ENDIF
-                  IF( ( mld_25h_init ) .OR. ( kt == nit000 ) ) THEN
-                     i_cnt_25h = 1
-                     IF( .NOT. ALLOCATED(hmld_zint_25h) ) THEN
-                        ALLOCATE( hmld_zint_25h(jpi,jpj,nn_mld_diag), STAT=ierror )
-                        IF( ierror > 0 )  CALL ctl_stop( 'zdf_mxl_zint 25h: unable to allocate hmld_zint_25h' )   
-                     ENDIF
-                     hmld_zint_25h(:,:,jn) = hmld_zint(:,:)
-                  ENDIF
-                  IF( MOD( kt, i_steps ) == 0 .AND.  kt .NE. nn_it000 ) THEN
-                     hmld_zint_25h(:,:,jn) = hmld_zint_25h(:,:,jn) + hmld_zint(:,:)
-                  ENDIF
-                  IF( i_cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
-                     CALL iom_put( "mldzint25h_"//cmld , hmld_zint_25h(:,:,jn) / 25._wp   )
-                  ENDIF
-               ENDIF
-
-            ENDIF
-         END DO
-                  
-         IF(  mld_25h_write  ) THEN
-            IF( ( MOD( kt, i_steps ) == 0 ) .OR.  mld_25h_init ) THEN
-               IF (lwp) THEN
-                  WRITE(numout,*) 'zdf_mxl_zint (25h) : Summed the following number of hourly values so far',i_cnt_25h
-	       ENDIF
-               i_cnt_25h = i_cnt_25h + 1
-               IF( mld_25h_init ) mld_25h_init = .FALSE.
-            ENDIF
-            IF( i_cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
-               i_cnt_25h = 1 
-               DO jn = 1, nn_mld_diag 
-                     hmld_zint_25h(:,:,jn) = hmld_zint(:,:) 
-               ENDDO 
-            ENDIF
-         ENDIF
-                  
-      ENDIF
-
-   END SUBROUTINE zdf_mxl_zint
-
    !!======================================================================
 END MODULE zdfmxl
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 10251)
@@ -53,10 +53,4 @@
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-#if defined key_agrif
-   USE agrif_opa_interp
-   USE agrif_opa_update
-#endif
-
-
 
    IMPLICIT NONE
@@ -190,9 +184,4 @@
       avmv_k(:,:,:) = avmv(:,:,:) 
       !
-#if defined key_agrif
-      ! Update child grid f => parent grid 
-      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only
-#endif      
-     ! 
    END SUBROUTINE zdf_tke
 
@@ -323,6 +312,5 @@
                   zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
                   !                                           ! TKE Langmuir circulation source term
-                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) /   &
-                     &   zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
             END DO
@@ -717,5 +705,5 @@
       !!----------------------------------------------------------------------
       INTEGER ::   ji, jj, jk   ! dummy loop indices
-      INTEGER ::   ios, ierr
+      INTEGER ::   ios
       !!
       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,   &
@@ -775,8 +763,5 @@
       ENDIF
       
-      IF( nn_etau == 2  ) THEN
-          ierr = zdf_mxl_alloc()
-          nmln(:,:) = nlb10           ! Initialization of nmln
-      ENDIF
+      IF( nn_etau == 2  )   CALL zdf_mxl( nit000 )      ! Initialization of nmln 
 
       !                               !* depth of penetration of surface tke
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 10251)
@@ -85,8 +85,4 @@
    USE stopar
    USE stopts
-   USE diatmb          ! Top,middle,bottom output
-   USE dia25h          ! 25h mean output
-   USE diaopfoam       ! FOAM operational output
-   USE diurnal_bulk    ! diurnal bulk SST 
 
    IMPLICIT NONE
@@ -165,11 +161,7 @@
           ENDIF
 
-#if defined key_agrif
-          CALL Agrif_Regrid()
-#endif
-
          DO WHILE ( istp <= nitend .AND. nstop == 0 )
 #if defined key_agrif
-            CALL stp                         ! AGRIF: time stepping
+            CALL Agrif_Step( stp )           ! AGRIF: time stepping
 #else
             CALL stp( istp )                 ! standard time stepping
@@ -195,10 +187,8 @@
       !
 #if defined key_agrif
-      IF( .NOT. Agrif_Root() ) THEN
-         CALL Agrif_ParentGrid_To_ChildGrid()
-         IF( lk_diaobs ) CALL dia_obs_wri
-         IF( nn_timing == 1 )   CALL timing_finalize
-         CALL Agrif_ChildGrid_To_ParentGrid()
-      ENDIF
+      CALL Agrif_ParentGrid_To_ChildGrid()
+      IF( lk_diaobs ) CALL dia_obs_wri
+      IF( nn_timing == 1 )   CALL timing_finalize
+      CALL Agrif_ChildGrid_To_ParentGrid()
 #endif
       IF( nn_timing == 1 )   CALL timing_finalize
@@ -344,14 +334,6 @@
          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
 #endif
-      ENDIF         
+      ENDIF
          jpk = jpkdta                                             ! third dim
-#if defined key_agrif
-         ! simple trick to use same vertical grid as parent
-         ! but different number of levels: 
-         ! Save maximum number of levels in jpkdta, then define all vertical grids
-         ! with this number.
-         ! Suppress once vertical online interpolation is ok
-         IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta)
-#endif
          jpim1 = jpi-1                                            ! inner domain indices
          jpjm1 = jpj-1                                            !   "           "
@@ -407,7 +389,4 @@
                             CALL  istate_init   ! ocean initial state (Dynamics and tracers)
 
-      CALL diurnal_sst_bulk_init                ! diurnal sst
-      IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin  
-
       IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics
 
@@ -480,15 +459,6 @@
 
       !                                     ! Assimilation increments
-      IF( lk_asminc ) THEN 
-#if defined key_shelf 
-         CALL  zdf_mxl_tref()     ! Initialization of hmld_tref
-#endif 
-         CALL asm_inc_init     ! Initialize assimilation increments 
-      ENDIF
-
+      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
       IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
-                            CALL dia_tmb_init  ! TMB outputs
-                            CALL dia_25h_init  ! 25h mean  outputs
-                            CALL dia_diaopfoam_init  ! FOAM operational output
       !
    END SUBROUTINE nemo_init
@@ -646,5 +616,4 @@
       USE ldftra_oce, ONLY: ldftra_oce_alloc
       USE trc_oce   , ONLY: trc_oce_alloc
-      USE diainsitutem, ONLY: insitu_tem_alloc
 #if defined key_diadct 
       USE diadct    , ONLY: diadct_alloc 
@@ -663,5 +632,4 @@
       ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
       ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
-      ierr = ierr + insitu_tem_alloc()
       !
       ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
@@ -742,11 +710,10 @@
       INTEGER :: ifac, jl, inu
       INTEGER, PARAMETER :: ntest = 14
-      INTEGER, DIMENSION(ntest) :: ilfax
-      !
-      ! ilfax contains the set of allowed factors.
-      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
-      !!----------------------------------------------------------------------
-      ! ilfax contains the set of allowed factors.
-      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      INTEGER :: ilfax(ntest)
+      !
+      ! lfax contains the set of allowed factors.
+      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
+         &                            128,   64,   32,   16,    8,   4,   2  /
+      !!----------------------------------------------------------------------
 
       ! Clear the error flag and initialise output vars
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 10251)
@@ -50,5 +50,5 @@
 
 #if defined key_agrif
-   RECURSIVE SUBROUTINE stp( )
+   SUBROUTINE stp( )
       INTEGER             ::   kstp   ! ocean time-step index
 #else
@@ -79,11 +79,7 @@
 #if defined key_agrif
       kstp = nit000 + Agrif_Nb_Step()
-      IF ( lk_agrif_debug ) THEN
-         IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
-         IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint()
-      ENDIF
-
+!      IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
+!      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp
       IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE.
-
 # if defined key_iomput
       IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
@@ -114,6 +110,5 @@
       ! Update stochastic parameters and random T/S fluctuations
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-       IF( ln_sto_eos ) CALL sto_par( kstp )          ! Stochastic parameters
-       IF( ln_sto_eos ) CALL sto_pts( tsn  )          ! Random T/S fluctuations
+                        CALL sto_par( kstp )          ! Stochastic parameters
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -157,4 +152,5 @@
       !
       IF( lk_ldfslp ) THEN                            ! slope of lateral mixing
+         IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations
                          CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density
          IF( ln_zps .AND. .NOT. ln_isfcav)                               &
@@ -192,4 +188,5 @@
           ! Note that the computation of vertical velocity above, hence "after" sea level
           ! is necessary to compute momentum advection for the rhs of barotropic loop:
+            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations
                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation
             IF( ln_zps .AND. .NOT. ln_isfcav)                               &
@@ -203,5 +200,5 @@
                                   ua(:,:,:) = 0.e0             ! set dynamics trends to zero
                                   va(:,:,:) = 0.e0
-          IF(  lk_asminc .AND. ln_asmiau .AND. &
+          IF(  ln_asmiau .AND. &
              & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment
           IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! subtract Neptune velocities (simplified)
@@ -225,15 +222,4 @@
       ENDIF
 
-      ! Cool skin
-      IF ( ln_diurnal ) THEN  
-         IF ( ln_blk_core ) THEN
-            CALL diurnal_sst_coolskin_step( &  
-                    qns(:,:)+(rn_abs*qsr(:,:)), taum, rhop(:,:,1), rdt) 
-         ELSE
-            CALL diurnal_sst_coolskin_step( &  
-                    qns, taum, rhop(:,:,1), rdt) 
-         ENDIF
-      ENDIF
-
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! diagnostics and outputs             (ua, va, tsa used as workspace)
@@ -249,29 +235,4 @@
       IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output
 
-      !Diurnal warm layer model        
-      IF ( ln_diurnal ) THEN
-         IF ( ln_blk_core ) THEN
-            IF( kstp == nit000 )THEN  
-               CALL diurnal_sst_takaya_step( &  
-               &    qsr(:,:)-(rn_abs*qsr(:,:)), qns(:,:)+(rn_abs*qsr(:,:)), &
-               &    taum, rhop(:,:,1), &
-               &    rdt, ld_calcfrac = .TRUE.)  
-            ELSE  
-               CALL diurnal_sst_takaya_step( &  
-               &    qsr(:,:)-(rn_abs*qsr(:,:)), qns(:,:)+(rn_abs*qsr(:,:)), &
-               &    taum, rhop(:,:,1), rdt )  
-            ENDIF 
-         ELSE
-            IF( kstp == nit000 )THEN  
-               CALL diurnal_sst_takaya_step( &  
-               &    qsr, qns, taum, rhop(:,:,1), &
-               &    rdt, ld_calcfrac = .TRUE.)  
-            ELSE  
-               CALL diurnal_sst_takaya_step( &  
-               &    qsr, qns, taum, rhop(:,:,1), rdt )  
-            ENDIF 
-         ENDIF
-      ENDIF
-
 #if defined key_top
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -287,9 +248,8 @@
                              tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
 
-      IF(  lk_asminc .AND. ln_asmiau .AND. &
+      IF(  ln_asmiau .AND. &
          & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment
                              CALL tra_sbc    ( kstp )       ! surface boundary condition
       IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr
-      IF( ln_tradwl      )   CALL tra_dwl    ( kstp )       ! Polcoms Style Short Wave Radiation 
       IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux
       IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme
@@ -310,4 +270,5 @@
          IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
                              CALL tra_nxt( kstp )                ! tracer fields at next time step
+            IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations
                              CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation
             IF( ln_zps .AND. .NOT. ln_isfcav)                                &
@@ -320,4 +281,5 @@
       ELSE                                                  ! centered hpg  (eos then time stepping)
          IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case
+            IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations
                              CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation
          IF( ln_zps .AND. .NOT. ln_isfcav)                                   &
@@ -336,7 +298,4 @@
       ! Dynamics                                    (tsa used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-      IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields
-
       IF( lk_dynspg_ts   )  THEN
                                                              ! revert to previously computed momentum tendencies
@@ -355,6 +314,7 @@
                                va(:,:,:) = 0.e0
 
-        IF(  lk_asminc .AND. ln_asmiau .AND. &
+        IF(  ln_asmiau .AND. &
            & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment
+        IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields
         IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified)
         IF( lk_bdy          )  CALL bdy_dyn3d_dmp(kstp )    ! bdy damping trends
@@ -376,20 +336,9 @@
       IF( lk_vvl           )   CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
 
-#if defined key_agrif
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! AGRIF
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
-                               CALL Agrif_Integrate_ChildGrids( stp )  
-
-      IF ( Agrif_NbStepint().EQ.0 ) THEN
-                               CALL Agrif_Update_Tra()      ! Update active tracers
-                               CALL Agrif_Update_Dyn()      ! Update momentum
-      ENDIF
-#endif
       IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics
       IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Control
+      ! Control and restarts
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                                CALL stp_ctl( kstp, indic )
@@ -398,5 +347,4 @@
                                CALL dia_wri_state( 'output.abort', kstp )
       ENDIF
-      IF( ln_harm_ana_store   )   CALL harm_ana( kstp )        ! Harmonic analysis of tides 
       IF( kstp == nit000   )   THEN
                  CALL iom_close( numror )     ! close input  ocean restart file
@@ -419,5 +367,4 @@
       !
       IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
-      !     
       !
    END SUBROUTINE stp
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 10251)
@@ -25,5 +25,4 @@
    USE sbcrnf           ! surface boundary condition: runoff variables
    USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
-   USE sbcflx           ! surface boundary condition: Fluxes
    USE sbc_oce          ! surface boundary condition: ocean
    USE sbctide          ! Tide initialisation
@@ -31,5 +30,4 @@
 
    USE traqsr           ! solar radiation penetration      (tra_qsr routine)
-   USE tradwl           ! POLCOMS style solar radiation    (tra_dwl routine) 
    USE trasbc           ! surface boundary condition       (tra_sbc routine)
    USE trabbc           ! bottom boundary condition        (tra_bbc routine)
@@ -108,10 +106,5 @@
    USE prtctl           ! Print control                    (prt_ctl routine)
 
-   USE harmonic_analysis ! harmonic analysis of tides (harm_ana routine) 
-   USE bdytides          ! harmonic analysis of tides (harm_ana routine) 
    USE diaobs           ! Observation operator
-
-   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine)  
-   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)
 
    USE timing           ! Timing
@@ -119,5 +112,4 @@
 #if defined key_agrif
    USE agrif_opa_sponge ! Momemtum and tracers sponges
-   USE agrif_opa_update ! Update (2-way nesting)
 #endif
 #if defined key_top
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 10251)
@@ -17,5 +17,4 @@
    USE dom_oce         ! ocean space and time domain variables 
    USE sol_oce         ! ocean space and time domain variables 
-   USE sbc_oce         ! surface boundary conditions variables
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
@@ -23,5 +22,4 @@
    USE dynspg_oce      ! pressure gradient schemes 
    USE c1d             ! 1D vertical configuration
-
 
    IMPLICIT NONE
@@ -54,5 +52,4 @@
       INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
       !!
-      CHARACTER(len = 32) ::        clfname ! time stepping output file name
       INTEGER  ::   ji, jj, jk              ! dummy loop indices
       INTEGER  ::   ii, ij, ik              ! temporary integers
@@ -66,11 +63,6 @@
          WRITE(numout,*) 'stp_ctl : time-stepping control'
          WRITE(numout,*) '~~~~~~~'
-         ! open time.step file with special treatment for SAS
-         IF ( nn_components == jp_iam_sas ) THEN
-            clfname = 'time.step.sas'
-         ELSE
-            clfname = 'time.step'
-         ENDIF
-         CALL ctl_opn( numstp, TRIM(clfname), 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
       ENDIF
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 10251)
@@ -27,6 +27,4 @@
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3         !: light absortion coefficient
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol        !: volume for degraded regions
-   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rlambda2      !: Lambda2 for downwell version of Short wave Radiation
-   REAL(wp), PUBLIC                                      ::   rlambda       !: Lambda  for downwell version of Short wave Radiation
 
 #if defined key_top 
@@ -80,14 +78,12 @@
       !!                  ***  trc_oce_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER ::   ierr(3)        ! Local variables
+      INTEGER ::   ierr(2)        ! Local variables
       !!----------------------------------------------------------------------
       ierr(:) = 0
                      ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) )
       IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) )
-                    ALLOCATE( rlambda2(jpi,jpj),   STAT=ierr(3) )
       trc_oce_alloc  = MAXVAL( ierr )
       !
       IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
-      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3, facvol or rlambda2 array')
    END FUNCTION trc_oce_alloc
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/SAS_SRC/daymod.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 10251)
@@ -71,9 +71,4 @@
       !!----------------------------------------------------------------------
       !
-      ! max number of seconds between each restart
-      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
-         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
-            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
-      ENDIF
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
       IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
@@ -244,4 +239,9 @@
                nday_year = 1
                nsec_year = ndt05
+               IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN   ! test integer 4 max value
+                  CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ',   &
+                     &           'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', &
+                     & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' )
+               ENDIF
                nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
                IF( nleapy == 1 )   CALL day_mth
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 10251)
@@ -521,5 +521,5 @@
 #endif
       !
-      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7,ierr8
+      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6
       INTEGER :: jpm
       !!----------------------------------------------------------------------
@@ -545,7 +545,5 @@
       ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 )
       ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 )
-      ALLOCATE( un(jpi,jpj,1)       , STAT=ierr7 )
-      ALLOCATE( vn(jpi,jpj,1)       , STAT=ierr8 )
-      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6  + ierr7 + ierr8
+      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 
 #endif
       !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 10251)
@@ -18,5 +18,4 @@
    USE trd_oce
    USE trdtrc
-   USE trcbc, only : trc_bc_read
 
    IMPLICIT NONE
@@ -56,6 +55,4 @@
 
       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt )
-
-      CALL trc_bc_read  ( kt )       ! tracers: surface and lateral Boundary Conditions
 
       IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 10251)
@@ -19,17 +19,9 @@
 
    PUBLIC trc_wri_my_trc 
-#if defined key_tracer_budget
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE :: trb_temp ! slwa
-#endif
-
 
 #  include "top_substitute.h90"
 CONTAINS
 
-#if defined key_tracer_budget
-   SUBROUTINE trc_wri_my_trc (kt, fl) ! slwa
-#else
    SUBROUTINE trc_wri_my_trc
-#endif
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri_trc  ***
@@ -37,52 +29,14 @@
       !! ** Purpose :   output passive tracers fields 
       !!---------------------------------------------------------------------
-#if defined key_tracer_budget
-      INTEGER, INTENT( in ), OPTIONAL     :: fl 
-      INTEGER, INTENT( in )               :: kt
-      REAL(wp), DIMENSION(jpi,jpj,jpk)    :: trpool !tracer pool temporary output
-#else
-      INTEGER, INTENT( in )               :: kt
-#endif
       CHARACTER (len=20)   :: cltra
-      INTEGER              :: jn,jk ! JC TODO jk defined here but may not be used
+      INTEGER              :: jn
       !!---------------------------------------------------------------------
  
       ! write the tracer concentrations in the file
       ! ---------------------------------------
-
-
-#if defined key_tracer_budget
-      IF( PRESENT(fl)) THEN
-! depth integrated
-! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt
-         DO jn = jp_myt0, jp_myt1 
-          IF(ln_trdtrc (jn))THEN
-            trpool(:,:,:) = 0.5 * ( trn(:,:,:,jn) * fse3t_a(:,:,:) +  &
-                                        trb_temp(:,:,:,jn) * fse3t(:,:,:) )
-            cltra = TRIM( ctrcnm(jn) )//"e3t"     ! depth integrated output
-            IF( kt == nittrc000 ) write(6,*)'output pool ',cltra
-            DO jk = 1, jpk
-               trpool(:,:,jk) = trpool(:,:,jk)
-            END DO
-            CALL iom_put( cltra, trpool)
-
-          END IF
-         END DO
-
-      ELSE
-
-         IF( kt == nittrc000 ) THEN
-           ALLOCATE(trb_temp(jpi,jpj,jpk,jp_my_trc))  ! slwa
-         ENDIF
-         trb_temp(:,:,:,:)=trn(:,:,:,:) ! slwa save for tracer budget (unfiltered trn)
-
-
-      END IF
-#else
       DO jn = jp_myt0, jp_myt1
          cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
          CALL iom_put( cltra, trn(:,:,:,jn) )
       END DO
-#endif
       !
    END SUBROUTINE trc_wri_my_trc
@@ -94,13 +48,5 @@
    PUBLIC trc_wri_my_trc
 CONTAINS
-#if defined key_tracer_budget
-   SUBROUTINE trc_wri_my_trc (kt, fl) ! slwa
-      INTEGER, INTENT( in ), OPTIONAL     :: fl 
-      INTEGER, INTENT( in )               :: kt
-#else
-   ! JC TODO Subroutine arguments (kt) inconsistent with earlier definition
-   SUBROUTINE trc_wri_my_trc (kt)
-      INTEGER, INTENT( in )               :: kt
-#endif
+   SUBROUTINE trc_wri_my_trc                     ! Empty routine  
    END SUBROUTINE trc_wri_my_trc
 #endif
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 10251)
@@ -599,3 +599,3 @@
 
    !!======================================================================
-END MODULE p2zbio
+END MODULE  p2zbio
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 10251)
@@ -84,3 +84,3 @@
 
    !!======================================================================
-END MODULE p2zsms
+END MODULE  p2zsms
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 10251)
@@ -109,3 +109,4 @@
 
    !!======================================================================
-END MODULE p4zbio
+END MODULE  p4zbio
+
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 10251)
@@ -396,3 +396,3 @@
 
    !!======================================================================
-END MODULE p4zche
+END MODULE  p4zche
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 10251)
@@ -400,3 +400,3 @@
 
    !!======================================================================
-END MODULE p4zflx
+END MODULE  p4zflx
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 10251)
@@ -81,3 +81,3 @@
 
    !!======================================================================
-END MODULE p4zint
+END MODULE  p4zint
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 10251)
@@ -265,3 +265,3 @@
 
    !!======================================================================
-END MODULE p4zlim
+END MODULE  p4zlim
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 10251)
@@ -152,9 +152,7 @@
          IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r   * tmask(:,:,:) )
       ELSE
-         IF( ln_diatrc ) THEN
-            trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon     * tmask(:,:,:)
-         ENDIF
+         trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
+         trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:)
+         trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon     * tmask(:,:,:)
       ENDIF
       !
@@ -225,3 +223,3 @@
 #endif 
    !!======================================================================
-END MODULE p4zlys
+END MODULE  p4zlys
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 10251)
@@ -340,3 +340,3 @@
 
    !!======================================================================
-END MODULE p4zmeso
+END MODULE  p4zmeso
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 10251)
@@ -273,3 +273,3 @@
 
    !!======================================================================
-END MODULE p4zmicro
+END MODULE  p4zmicro
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 10251)
@@ -277,3 +277,3 @@
 
    !!======================================================================
-END MODULE p4zmort
+END MODULE  p4zmort
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 10251)
@@ -439,3 +439,3 @@
 
    !!======================================================================
-END MODULE p4zopt
+END MODULE  p4zopt
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 10251)
@@ -629,3 +629,3 @@
 
    !!======================================================================
-END MODULE p4zprod
+END MODULE  p4zprod
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 10251)
@@ -519,3 +519,3 @@
 
    !!======================================================================
-END MODULE p4zsbc
+END MODULE  p4zsbc
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 10251)
@@ -436,3 +436,3 @@
 
    !!======================================================================
-END MODULE p4zsed
+END MODULE  p4zsed
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 10251)
@@ -913,3 +913,3 @@
 
    !!======================================================================
-END MODULE p4zsink
+END MODULE  p4zsink
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 10251)
@@ -38,5 +38,5 @@
 
    REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
-   REAL(wp) :: xfact1, xfact2, xfact3
+   REAL(wp) :: xfact1, xfact2
    INTEGER ::  numco2, numnut, numnit  !: logical unit for co2 budget
 
@@ -474,6 +474,7 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
-      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot
+      INTEGER , INTENT( in ) ::   kt      ! ocean time-step index      
+      REAL(wp)               ::  zfact       
+      REAL(wp) ::  zrdenittot, zsdenittot, znitrpottot
       CHARACTER(LEN=100)   ::   cltxt
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
@@ -491,5 +492,4 @@
             xfact1 = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/yr
             xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/s ----> TgN/m3/yr
-            xfact3 = 1.e+3 * rfact2r * rno3   ! conversion molC/l/kt ----> molN/m3/s
             cltxt='time-step   Alkalinity        Nitrate        Phosphorus         Silicate           Iron'
             IF( lwp ) WRITE(numnut,*)  TRIM(cltxt)
@@ -574,5 +574,5 @@
       IF( iom_use( "Sdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
          zsdenittot   = glob_sum ( sdenit(:,:) * e1e2t(:,:) )
-         CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) )  ! Nitrate reduction in the sediments
+         CALL iom_put( "Sdenit", sdenit(:,:) * zfact * tmask(:,:,1) )  ! Nitrate reduction in the sediments
       ENDIF
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 10251)
@@ -29,24 +29,7 @@
 CONTAINS
 
-
    SUBROUTINE trc_ice_ini_pisces
       !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE trc_ini_pisces ***
-      !!
-      !! ** Purpose :   Initialisation of the PISCES biochemical model
-      !!----------------------------------------------------------------------
-
-      IF( lk_p4z ) THEN  ;   CALL p4z_ice_ini   !  PISCES
-      ELSE               ;   CALL p2z_ice_ini   !  LOBSTER
-      ENDIF
-
-   END SUBROUTINE trc_ice_ini_pisces
-
-
-   SUBROUTINE p4z_ice_ini
-
-#if defined key_pisces 
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE p4z_ice_ini ***
+      !!                   ***  ROUTINE trc_ice_ini_pisces ***
       !!
       !! ** Purpose :   PISCES fake sea ice model setting
@@ -75,8 +58,6 @@
 
                                         !--- Dummy variables
-      REAL(wp), DIMENSION(jp_pisces,2)  :: zratio  ! effective ice-ocean tracer cc ratio
-      REAL(wp), DIMENSION(jp_pisces,4)  :: zpisc   ! prescribes concentration 
-      !                                            !  1:global, 2:Arctic, 3:Antarctic, 4:Baltic
-
+      REAL(wp), DIMENSION(jptra,2) &
+               ::  zratio            ! effective ice-ocean tracer cc ratio
       REAL(wp), DIMENSION(2) :: zrs  ! ice-ocean salinity ratio, 1 - global, 2- Baltic
       REAL(wp) :: zsice_bal          ! prescribed ice salinity in the Baltic
@@ -99,139 +80,128 @@
       ! fluxes
 
-      !--- Global values
-      zpisc(jpdic,1) =  1.99e-3_wp 
-      zpisc(jpdoc,1) =  2.04e-5_wp 
-      zpisc(jptal,1) =  2.31e-3_wp 
-      zpisc(jpoxy,1) =  2.47e-4_wp
-      zpisc(jpcal,1) =  1.04e-8_wp
-      zpisc(jppo4,1) =  5.77e-7_wp / po4r 
-      zpisc(jppoc,1) =  1.27e-6_wp  
-#  if ! defined key_kriest
-      zpisc(jpgoc,1) =  5.23e-8_wp  
-      zpisc(jpbfe,1) =  9.84e-13_wp 
-#  else
-      zpisc(jpnum,1) = 0. ! could not get this value since did not use it
-#  endif
-      zpisc(jpsil,1) =  7.36e-6_wp  
-      zpisc(jpdsi,1) =  1.07e-7_wp 
-      zpisc(jpgsi,1) =  1.53e-8_wp
-      zpisc(jpphy,1) =  9.57e-8_wp
-      zpisc(jpdia,1) =  4.24e-7_wp
-      zpisc(jpzoo,1) =  6.07e-7_wp
-      zpisc(jpmes,1) =  3.44e-7_wp
-      zpisc(jpfer,1) =  4.06e-10_wp
-      zpisc(jpsfe,1) =  2.51e-11_wp
-      zpisc(jpdfe,1) =  6.57e-12_wp
-      zpisc(jpnfe,1) =  1.76e-11_wp
-      zpisc(jpnch,1) =  1.67e-7_wp
-      zpisc(jpdch,1) =  1.02e-7_wp
-      zpisc(jpno3,1) =  5.79e-6_wp / rno3 
-      zpisc(jpnh4,1) =  3.22e-7_wp / rno3
+      !--- Global case 
+      IF ( cn_trc_o(jpdic) == 'GL ' ) trc_o(:,:,jpdic) =  1.99e-3_wp 
+      IF ( cn_trc_o(jpdoc) == 'GL ' ) trc_o(:,:,jpdoc) =  2.04e-5_wp 
+      IF ( cn_trc_o(jptal) == 'GL ' ) trc_o(:,:,jptal) =  2.31e-3_wp 
+      IF ( cn_trc_o(jpoxy) == 'GL ' ) trc_o(:,:,jpoxy) =  2.47e-4_wp
+      IF ( cn_trc_o(jpcal) == 'GL ' ) trc_o(:,:,jpcal) =  1.04e-8_wp
+      IF ( cn_trc_o(jppo4) == 'GL ' ) trc_o(:,:,jppo4) =  5.77e-7_wp / po4r 
+      IF ( cn_trc_o(jppoc) == 'GL ' ) trc_o(:,:,jppoc) =  1.27e-6_wp  
+#  if ! defined key_kriest
+      IF ( cn_trc_o(jpgoc) == 'GL ' ) trc_o(:,:,jpgoc) =  5.23e-8_wp  
+      IF ( cn_trc_o(jpbfe) == 'GL ' ) trc_o(:,:,jpbfe) =  9.84e-13_wp 
+#  else
+      IF ( cn_trc_o(jpnum) == 'GL ' ) trc_o(:,:,jpnum) = 0. ! could not get this value since did not use it
+#  endif
+      IF ( cn_trc_o(jpsil) == 'GL ' ) trc_o(:,:,jpsil) =  7.36e-6_wp  
+      IF ( cn_trc_o(jpdsi) == 'GL ' ) trc_o(:,:,jpdsi) =  1.07e-7_wp 
+      IF ( cn_trc_o(jpgsi) == 'GL ' ) trc_o(:,:,jpgsi) =  1.53e-8_wp
+      IF ( cn_trc_o(jpphy) == 'GL ' ) trc_o(:,:,jpphy) =  9.57e-8_wp
+      IF ( cn_trc_o(jpdia) == 'GL ' ) trc_o(:,:,jpdia) =  4.24e-7_wp
+      IF ( cn_trc_o(jpzoo) == 'GL ' ) trc_o(:,:,jpzoo) =  6.07e-7_wp
+      IF ( cn_trc_o(jpmes) == 'GL ' ) trc_o(:,:,jpmes) =  3.44e-7_wp
+      IF ( cn_trc_o(jpfer) == 'GL ' ) trc_o(:,:,jpfer) =  4.06e-10_wp
+      IF ( cn_trc_o(jpsfe) == 'GL ' ) trc_o(:,:,jpsfe) =  2.51e-11_wp
+      IF ( cn_trc_o(jpdfe) == 'GL ' ) trc_o(:,:,jpdfe) =  6.57e-12_wp
+      IF ( cn_trc_o(jpnfe) == 'GL ' ) trc_o(:,:,jpnfe) =  1.76e-11_wp
+      IF ( cn_trc_o(jpnch) == 'GL ' ) trc_o(:,:,jpnch) =  1.67e-7_wp
+      IF ( cn_trc_o(jpdch) == 'GL ' ) trc_o(:,:,jpdch) =  1.02e-7_wp
+      IF ( cn_trc_o(jpno3) == 'GL ' ) trc_o(:,:,jpno3) =  5.79e-6_wp / rno3 
+      IF ( cn_trc_o(jpnh4) == 'GL ' ) trc_o(:,:,jpnh4) =  3.22e-7_wp / rno3
 
       !--- Arctic specificities (dissolved inorganic & DOM)
-      zpisc(jpdic,2) =  1.98e-3_wp 
-      zpisc(jpdoc,2) =  6.00e-6_wp 
-      zpisc(jptal,2) =  2.13e-3_wp 
-      zpisc(jpoxy,2) =  3.65e-4_wp  
-      zpisc(jpcal,2) =  1.50e-9_wp  
-      zpisc(jppo4,2) =  4.09e-7_wp / po4r 
-      zpisc(jppoc,2) =  4.05e-7_wp  
-#  if ! defined key_kriest
-      zpisc(jpgoc,2) =  2.84e-8_wp  
-      zpisc(jpbfe,2) =  7.03e-13_wp 
-#  else
-      zpisc(jpnum,2) =  0.00e-00_wp 
-#  endif
-      zpisc(jpsil,2) =  6.87e-6_wp  
-      zpisc(jpdsi,2) =  1.73e-7_wp 
-      zpisc(jpgsi,2) =  7.93e-9_wp
-      zpisc(jpphy,2) =  5.25e-7_wp  
-      zpisc(jpdia,2) =  7.75e-7_wp 
-      zpisc(jpzoo,2) =  3.34e-7_wp
-      zpisc(jpmes,2) =  2.49e-7_wp  
-      zpisc(jpfer,2) =  1.43e-9_wp 
-      zpisc(jpsfe,2) =  2.21e-11_wp 
-      zpisc(jpdfe,2) =  2.04e-11_wp 
-      zpisc(jpnfe,2) =  1.75e-11_wp 
-      zpisc(jpnch,2) =  1.46e-07_wp 
-      zpisc(jpdch,2) =  2.36e-07_wp 
-      zpisc(jpno3,2) =  3.51e-06_wp / rno3 
-      zpisc(jpnh4,2) =  6.15e-08_wp / rno3 
+      IF ( cn_trc_o(jpdic) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdic) =  1.98e-3_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdoc) =  6.00e-6_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jptal) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jptal) =  2.13e-3_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpoxy) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpoxy) =  3.65e-4_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpcal) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpcal) =  1.50e-9_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jppo4) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jppo4) =  4.09e-7_wp / po4r ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jppoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jppoc) =  4.05e-7_wp  ; END WHERE ; ENDIF
+#  if ! defined key_kriest
+      IF ( cn_trc_o(jpgoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpgoc) =  2.84e-8_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpbfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpbfe) =  7.03e-13_wp ; END WHERE ; ENDIF
+#  else
+      IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnum) =  0.00e-00_wp ; END WHERE ; ENDIF
+#  endif
+      IF ( cn_trc_o(jpsil) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpsil) =  6.87e-6_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdsi) =  1.73e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpgsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpgsi) =  7.93e-9_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpphy) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpphy) =  5.25e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdia) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdia) =  7.75e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpzoo) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpzoo) =  3.34e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpmes) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpmes) =  2.49e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpfer) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpfer) =  1.43e-9_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpsfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpsfe) =  2.21e-11_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdfe) =  2.04e-11_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpnfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnfe) =  1.75e-11_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpnch) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnch) =  1.46e-07_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdch) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdch) =  2.36e-07_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpno3) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpno3) =  3.51e-06_wp / rno3 ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpnh4) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnh4) =  6.15e-08_wp / rno3 ; END WHERE ; ENDIF
 
       !--- Antarctic specificities (dissolved inorganic & DOM)
-      zpisc(jpdic,3) =  2.20e-3_wp  
-      zpisc(jpdoc,3) =  7.02e-6_wp  
-      zpisc(jptal,3) =  2.37e-3_wp  
-      zpisc(jpoxy,3) =  3.42e-4_wp  
-      zpisc(jpcal,3) =  3.17e-9_wp  
-      zpisc(jppo4,3) =  1.88e-6_wp / po4r  
-      zpisc(jppoc,3) =  1.13e-6_wp  
-#  if ! defined key_kriest
-      zpisc(jpgoc,3) =  2.89e-8_wp  
-      zpisc(jpbfe,3) =  5.63e-13_wp 
-#  else
-      zpisc(jpnum,3) =  0.00e-00_wp 
-#  endif
-      zpisc(jpsil,3) =  4.96e-5_wp  
-      zpisc(jpdsi,3) =  5.63e-7_wp 
-      zpisc(jpgsi,3) =  5.35e-8_wp
-      zpisc(jpphy,3) =  8.10e-7_wp  
-      zpisc(jpdia,3) =  5.77e-7_wp 
-      zpisc(jpzoo,3) =  6.68e-7_wp
-      zpisc(jpmes,3) =  3.55e-7_wp  
-      zpisc(jpfer,3) =  1.62e-10_wp
-      zpisc(jpsfe,3) =  2.29e-11_wp 
-      zpisc(jpdfe,3) =  8.75e-12_wp
-      zpisc(jpnfe,3) =  1.48e-11_wp 
-      zpisc(jpnch,3) =  2.02e-7_wp  
-      zpisc(jpdch,3) =  1.60e-7_wp  
-      zpisc(jpno3,3) =  2.64e-5_wp / rno3  
-      zpisc(jpnh4,3) =  3.39e-7_wp / rno3  
+      IF ( cn_trc_o(jpdic) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdic) =  2.20e-3_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdoc) =  7.02e-6_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jptal) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jptal) =  2.37e-3_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpoxy) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpoxy) =  3.42e-4_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpcal) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpcal) =  3.17e-9_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jppo4) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jppo4) =  1.88e-6_wp / po4r  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jppoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jppoc) =  1.13e-6_wp  ; END WHERE ; ENDIF
+#  if ! defined key_kriest
+      IF ( cn_trc_o(jpgoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpgoc) =  2.89e-8_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpbfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpbfe) =  5.63e-13_wp ; END WHERE ; ENDIF
+#  else
+      IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnum) =  0.00e-00_wp ; END WHERE ; ENDIF
+#  endif
+      IF ( cn_trc_o(jpsil) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpsil) =  4.96e-5_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdsi) =  5.63e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpgsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpgsi) =  5.35e-8_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpphy) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpphy) =  8.10e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdia) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdia) =  5.77e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpzoo) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpzoo) =  6.68e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpmes) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpmes) =  3.55e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpfer) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpfer) =  1.62e-10_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpsfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpsfe) =  2.29e-11_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdfe) =  8.75e-12_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpnfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnfe) =  1.48e-11_wp ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpnch) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnch) =  2.02e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpdch) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdch) =  1.60e-7_wp  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpno3) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpno3) =  2.64e-5_wp / rno3  ; END WHERE ; ENDIF
+      IF ( cn_trc_o(jpnh4) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnh4) =  3.39e-7_wp / rno3  ; END WHERE ; ENDIF
 
       !--- Baltic Sea particular case for ORCA configurations
-      zpisc(jpdic,4) = 1.14e-3_wp
-      zpisc(jpdoc,4) = 1.06e-5_wp
-      zpisc(jptal,4) = 1.16e-3_wp
-      zpisc(jpoxy,4) = 3.71e-4_wp
-      zpisc(jpcal,4) = 1.51e-9_wp
-      zpisc(jppo4,4) = 2.85e-9_wp / po4r
-      zpisc(jppoc,4) = 4.84e-7_wp
-#  if ! defined key_kriest
-      zpisc(jpgoc,4) = 1.05e-8_wp
-      zpisc(jpbfe,4) = 4.97e-13_wp
-#  else
-      zpisc(jpnum,4) = 0. ! could not get this value
-#  endif
-      zpisc(jpsil,4) = 4.91e-5_wp
-      zpisc(jpdsi,4) = 3.25e-7_wp
-      zpisc(jpgsi,4) = 1.93e-8_wp
-      zpisc(jpphy,4) = 6.64e-7_wp
-      zpisc(jpdia,4) = 3.41e-7_wp
-      zpisc(jpzoo,4) = 3.83e-7_wp
-      zpisc(jpmes,4) = 0.225e-6_wp
-      zpisc(jpfer,4) = 2.45e-9_wp
-      zpisc(jpsfe,4) = 3.89e-11_wp
-      zpisc(jpdfe,4) = 1.33e-11_wp
-      zpisc(jpnfe,4) = 2.62e-11_wp
-      zpisc(jpnch,4) = 1.17e-7_wp
-      zpisc(jpdch,4) = 9.69e-8_wp
-      zpisc(jpno3,4) = 5.36e-5_wp / rno3
-      zpisc(jpnh4,4) = 7.18e-7_wp / rno3
- 
-      DO jn = jp_pcs0, jp_pcs1
-         IF( cn_trc_o(jn) == 'GL ' ) trc_o(:,:,jn) = zpisc(jn,1)  ! Global case
-         IF( cn_trc_o(jn) == 'AA ' ) THEN 
-            WHERE( gphit(:,:) >= 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,2) ; END WHERE ! Arctic 
-            WHERE( gphit(:,:) <  0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic 
-         ENDIF
-         IF( cp_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations
-             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
-                    54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
-                    trc_o(:,:,jn) = zpisc(jn,4)
-            END WHERE
-         ENDIF 
-      ENDDO
-
-
+      IF( cp_cfg == "orca" ) THEN            ! Baltic mask
+         WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+         trc_o(:,:,jpdic) = 1.14e-3_wp
+         trc_o(:,:,jpdoc) = 1.06e-5_wp
+         trc_o(:,:,jptal) = 1.16e-3_wp
+         trc_o(:,:,jpoxy) = 3.71e-4_wp
+         trc_o(:,:,jpcal) = 1.51e-9_wp
+         trc_o(:,:,jppo4) = 2.85e-9_wp / po4r
+         trc_o(:,:,jppoc) = 4.84e-7_wp
+#  if ! defined key_kriest
+         trc_o(:,:,jpgoc) = 1.05e-8_wp
+         trc_o(:,:,jpbfe) = 4.97e-13_wp
+#  else
+         trc_o(:,:,jpnum) = 0. ! could not get this value
+#  endif
+         trc_o(:,:,jpsil) = 4.91e-5_wp
+         trc_o(:,:,jpdsi) = 3.25e-7_wp
+         trc_o(:,:,jpgsi) = 1.93e-8_wp
+         trc_o(:,:,jpphy) = 6.64e-7_wp
+         trc_o(:,:,jpdia) = 3.41e-7_wp
+         trc_o(:,:,jpzoo) = 3.83e-7_wp
+         trc_o(:,:,jpmes) = 0.225e-6_wp
+         trc_o(:,:,jpfer) = 2.45e-9_wp
+         trc_o(:,:,jpsfe) = 3.89e-11_wp
+         trc_o(:,:,jpdfe) = 1.33e-11_wp
+         trc_o(:,:,jpnfe) = 2.62e-11_wp
+         trc_o(:,:,jpnch) = 1.17e-7_wp
+         trc_o(:,:,jpdch) = 9.69e-8_wp
+         trc_o(:,:,jpno3) = 5.36e-5_wp / rno3
+         trc_o(:,:,jpnh4) = 7.18e-7_wp / rno3
+         END WHERE
+      ENDIF ! cfg
 
       !-----------------------------
@@ -247,7 +217,7 @@
 
       DO jn = jp_pcs0, jp_pcs1
-         IF( trc_ice_ratio(jn) >= 0._wp )  zratio(jn,:) = trc_ice_ratio(jn)
-         IF( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:)
-         IF( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp
+         IF ( trc_ice_ratio(jn) >= 0._wp )  zratio(jn,:) = trc_ice_ratio(jn)
+         IF ( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:)
+         IF ( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp
       END DO
 
@@ -257,18 +227,20 @@
       DO jn = jp_pcs0, jp_pcs1
          !-- Everywhere but in the Baltic
-         IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 
+         IF ( trc_ice_ratio(jn) >= -1._wp ) THEN !! no prescribed concentration
+                                              !! (typically everything but iron) 
             trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn) 
-         ELSE                                    ! prescribed concentration
+         ELSE                                 !! prescribed concentration
             trc_i(:,:,jn) = trc_ice_prescr(jn)
          ENDIF
        
          !-- Baltic
-         IF( cp_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs
-            IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 
+         IF( cp_cfg == "orca" ) THEN !! Baltic treated seperately for ORCA configs
+            IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN !! no prescribed concentration
+                                                 !! (typically everything but iron) 
                WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
                       54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
                      trc_i(:,:,jn) = zratio(jn,2) * trc_o(:,:,jn) 
                END WHERE
-            ELSE                                 ! prescribed tracer concentration in ice
+            ELSE                                 !! prescribed tracer concentration in ice
                WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
                    54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
@@ -279,18 +251,6 @@
       !
       END DO ! jn
-#endif
-
-   END SUBROUTINE p4z_ice_ini
-
-   SUBROUTINE p2z_ice_ini
-#if defined key_pisces_reduced 
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE p2z_ice_ini ***
-      !!
-      !! ** Purpose :   Initialisation of the LOBSTER biochemical model
-      !!----------------------------------------------------------------------
-#endif
-   END SUBROUTINE p2z_ice_ini
-
+
+   END SUBROUTINE trc_ice_ini_pisces
 
 #else
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 10251)
@@ -56,5 +56,5 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      INTEGER            :: jn, jk
+      INTEGER            :: jn
       CHARACTER (len=22) :: charout
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
@@ -105,9 +105,4 @@
         DO jn = 1, jptra
            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
-#if defined key_tracer_budget
-           DO jk = 1, jpkm1
-             ztrtrd(:,:,jk,jn) = ztrtrd(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)  ! slwa
-           END DO
-#endif
            CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )
         END DO
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 10251)
@@ -33,7 +33,4 @@
    USE trdtra
    USE tranxt
-   USE trcbdy          ! BDY open boundaries
-   USE bdy_par, only: lk_bdy
-   USE iom
 # if defined key_agrif
    USE agrif_top_interp
@@ -96,7 +93,4 @@
       CHARACTER (len=22) :: charout
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrdt 
-#if defined key_tracer_budget
-      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztrdt_m1 ! slwa
-#endif
       !!----------------------------------------------------------------------
       !
@@ -107,23 +101,5 @@
          WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
       ENDIF
-#if defined key_tracer_budget
-      IF( kt == nittrc000 .AND. l_trdtrc ) THEN
-         ALLOCATE( ztrdt_m1(jpi,jpj,jpk,jptra) )  ! slwa
-         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file
-            iom_varid( numrtr, 'atf_trend_'//TRIM(ctrcnm(1)), ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc ATF tracer trend read in the restart file'
-            DO jn = 1, jptra
-               CALL iom_get( numrtr, jpdom_autoglo, 'atf_trend_'//TRIM(ctrcnm(jn)), ztrdt_m1(:,:,:,jn) )   ! before tracer trend for atf
-            END DO
-         ELSE          
-           ztrdt_m1=0.0
-         ENDIF
-      ENDIF
-#endif
 
-
-#if defined key_agrif
-      CALL Agrif_trc                   ! AGRIF zoom boundaries
-#endif
       ! Update after tracer on domain lateral boundaries
       DO jn = 1, jptra
@@ -132,5 +108,10 @@
 
 
-      IF( lk_bdy )  CALL trc_bdy( kt )               ! BDY open boundaries
+#if defined key_bdy
+!!      CALL bdy_trc( kt )               ! BDY open boundaries
+#endif
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
 
 
@@ -168,37 +149,9 @@
                zfact = 1.e0 / r2dt(jk)  
                ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 
-!slwa          CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt )
-#if defined key_tracer_budget
-               ztrdt(:,:,jk,jn) = ztrdt(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * e3t_n(:,:,jk)  ! slwa vvl
-               !ztrdt(:,:,jk,jn) = ztrdt(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * e3t_0(:,:,jk)  ! slwa CHANGE for vvl
-#endif
+               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt )
             END DO
-#if defined key_tracer_budget
-! slwa budget code
-              CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt_m1(:,:,:,jn) )
-#else
-              CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) )
-#endif
          END DO
-#if defined key_tracer_budget
-        ztrdt_m1(:,:,:,:) = ztrdt(:,:,:,:)    ! need previous time step for budget slwa
-#endif
          CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt ) 
       END IF
-
-#if defined key_tracer_budget
-      !                                           Write in the tracer restart file
-      !                                          *******************************
-      IF( lrst_trc ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc : ATF trend at last time step for tracer budget written in tracer restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
-         DO jn = 1, jptra
-            CALL iom_rstput( kt, nitrst, numrtw, 'atf_trend_'//TRIM(ctrcnm(jn)), ztrdt_m1(:,:,:,jn) )
-         END DO
-      ENDIF
-#endif
-
       !
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 10251)
@@ -18,7 +18,4 @@
    USE trdtra
    USE prtctl_trc          ! Print control for debbuging
-#if defined key_tracer_budget
-   USE iom
-#endif
 
    IMPLICIT NONE
@@ -54,7 +51,4 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index      
       CHARACTER (len=22) :: charout
-      ! +++>>> FABM
-      INTEGER :: jn
-      ! FABM <<<+++
       !!----------------------------------------------------------------------
       !
@@ -71,13 +65,5 @@
       IF( lk_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' )  ! PISCES model
       IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1               )  ! MY_TRC model
-      ! +++>>> FABM
-      IF( lk_fabm  )   THEN
-        DO jn=1,jp_fabm ! state variable loop
-          IF (lk_rad_fabm(jn)) THEN
-           CALL trc_rad_sms( kt, trb, trn, jn+jp_fabm_m1 , jn+jp_fabm_m1 )
-          ENDIF
-        END DO
-      END IF
-      ! FABM <<<+++
+
       !
       IF(ln_ctl) THEN      ! print mean trends (used for debugging)
@@ -124,7 +110,4 @@
       REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         "
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays
-#if defined key_tracer_budget
-      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztrtrdb_m1 ! slwa 
-#endif
       REAL(wp) :: zs2rdt
       LOGICAL ::   lldebug = .FALSE.
@@ -133,19 +116,4 @@
  
       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn )
-#if defined key_tracer_budget
-      IF( kt == nittrc000 .AND. l_trdtrc) THEN
-         IF (.not. ALLOCATED(ztrtrdb_m1)) ALLOCATE( ztrtrdb_m1(jpi,jpj,jpk,jptra) )  ! slwa
-            DO jn = jp_sms0, jp_sms1
-               IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file
-                  iom_varid( numrtr, 'rdb_trend_'//TRIM(ctrcnm(jn)), ldstop = .FALSE. ) > 0 ) THEN
-                  IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc RDB tracer trend read for',TRIM(ctrcnm(jn))
-                  CALL iom_get( numrtr, jpdom_autoglo, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) )   ! before tracer trend for rdb
-               ELSE
-                  IF(lwp) WRITE(numout,*) '          no nittrc000-nn_dttrc RDB tracer trend for',TRIM(ctrcnm(jn)),', setting to 0.'
-                  ztrtrdb_m1(:,:,:,jn)=0.0
-               ENDIF
-            END DO
-      ENDIF
-#endif
       
       IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved 
@@ -188,15 +156,5 @@
                ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt
                ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 
-#if defined key_tracer_budget
-! slwa budget code
-               DO jk = 1, jpkm1
-                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)
-                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)
-               END DO
-               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) )
-               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:)
-#else
                CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling
-#endif
                CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling
               !
@@ -229,15 +187,5 @@
                ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt
                ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 
-#if defined key_tracer_budget
-! slwa budget code
-               DO jk = 1, jpkm1
-                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)
-                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)
-               END DO
-               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) )
-               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:)
-#else
                CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling
-#endif
                CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling
               !
@@ -247,18 +195,4 @@
 
       ENDIF
-
-#if defined key_tracer_budget
-      !                                           Write in the tracer restart file
-      !                                          *******************************
-      IF( lrst_trc ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc : RDB trend at last time step for tracer budget written in tracer restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
-         DO jn = jp_sms0, jp_sms1
-            CALL iom_rstput( kt, nitrst, numrtw, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) )
-         END DO
-      ENDIF
-#endif
 
       IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 10251)
@@ -113,5 +113,4 @@
            sbc_trc_b(:,:,:) = 0._wp
          ENDIF
-         sbc_trc(:,:,:) = 0._wp    !slwa initialise for vvl
       ELSE                                         ! Swap of forcing fields
          IF( ln_top_euler ) THEN
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 10251)
@@ -27,6 +27,4 @@
    USE trcsbc          ! surface boundary condition          (trc_sbc routine)
    USE zpshde          ! partial step: hor. derivative       (zps_hde routine)
-   USE trcbdy          ! BDY open boundaries
-   USE bdy_par, only: lk_bdy
 
 #if defined key_agrif
@@ -70,5 +68,4 @@
          IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends
          IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only
-         IF( lk_bdy )           CALL trc_bdy_dmp( kstp )        ! BDY damping trends
                                 CALL trc_adv( kstp )            ! horizontal & vertical advection 
                                 CALL trc_ldf( kstp )            ! lateral mixing
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 10251)
@@ -102,13 +102,4 @@
          END SELECT
                                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
-         ! +++>>>FABM
-#if defined key_tracer_budget
-! for outputting depth integrated
-         SELECT CASE( ktrd )
-         CASE( jptra_xad, jptra_yad, jptra_zad  ) 
-           cltra = TRIM(cltra)//"_e3t"
-         END SELECT
-#endif
-         ! FABM <<<+++
                                           CALL iom_put( cltra,  ptrtrd(:,:,:) )
          !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 10251)
@@ -22,10 +22,5 @@
    CHARACTER(len=50) ::  cn_trdrst_trc_in     !: suffix of pass. tracer restart name (input)
    CHARACTER(len=50) ::  cn_trdrst_trc_out    !: suffix of pass. tracer restart name (output)
-   ! --->>> FABM
-   ! LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist)
-   ! FABM <<<---
-   ! +++>>> FABM
-   LOGICAL, DIMENSION(jpmaxtrc) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist)
-   ! FABM <<<+++
+   LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist)
 
 # if defined key_trdtrc && defined key_iomput
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 10251)
@@ -15,7 +15,4 @@
    USE par_cfc       ! CFC 11 and 12 tracers
    USE par_my_trc    ! user defined passive tracers
-   ! +++>>> FABM
-   USE par_fabm      ! FABM
-   ! FABM <<<+++
 
    IMPLICIT NONE
@@ -27,21 +24,9 @@
    ! Passive tracers : Total size
    ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays
-   ! --->>> FABM
-   ! INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc
-   ! INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d
-   ! INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d
-   ! FABM <<<---
-   ! +++>>> FABM
-   INTEGER, PUBLIC  ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc
-   INTEGER, PUBLIC  ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d
-   INTEGER, PUBLIC  ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d
-   ! FABM <<<+++
+   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc
+   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d
+   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d
    !                     ! total number of sms diagnostic arrays
-   ! --->>> FABM
-   ! INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd
-   ! FABM <<<---
-   ! +++>>> FABM
-   INTEGER, PUBLIC  ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd
-   ! FABM <<<+++
+   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd
    
    !  1D configuration ("key_c1d")
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 10251)
@@ -14,7 +14,4 @@
    USE par_oce
    USE par_trc
-#if defined key_bdy
-   USE bdy_oce, only: nb_bdy, OBC_DATA
-#endif
    
    IMPLICIT NONE
@@ -83,14 +80,7 @@
    END TYPE
 
-   ! --->>> FABM 
-   !REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio
-   !                                              trc_ice_prescr   ! prescribed ice trc cc
-   !CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc
-   ! FABM <<<---
-   ! +++>>> FABM 
-   REAL(wp), DIMENSION(jpmaxtrc), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio
+   REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio
                                                  trc_ice_prescr   ! prescribed ice trc cc
-   CHARACTER(len=2), DIMENSION(jpmaxtrc), PUBLIC :: cn_trc_o ! choice of ocean tracer cc
-   ! FABM <<<+++
+   CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc
 
    !! information for outputs
@@ -100,22 +90,6 @@
        CHARACTER(len = 80)  :: cllname  !: long name
        CHARACTER(len = 20)  :: clunit   !: unit
-! --->>> FABM
-!       LOGICAL              :: llinit   !: read in a file or not
-!!#if defined  key_my_trc
-!       LOGICAL              :: llsbc   !: read in a file or not
-!       LOGICAL              :: llcbc   !: read in a file or not
-!       LOGICAL              :: llobc   !: read in a file or not
-!#endif
-!       LOGICAL              :: llsave   !: save the tracer or not
-! FABM <<<---
-! +++ FABM
-       LOGICAL              :: llinit=.FALSE.   !: read in a file or not
-#if defined  key_fabm
-       LOGICAL              :: llsbc=.FALSE.   !: read in a file or not
-       LOGICAL              :: llcbc=.FALSE.   !: read in a file or not
-       LOGICAL              :: llobc=.FALSE.   !: read in a file or not
-#endif
-       LOGICAL              :: llsave=.FALSE.   !: save the tracer or not
-! FABM <<<+++
+       LOGICAL              :: llinit   !: read in a file or not
+       LOGICAL              :: llsave   !: save the tracer or not
    END TYPE PTRACER
    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name 
@@ -217,11 +191,4 @@
 # endif
    !
-#if defined key_bdy
-   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers
-   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers
-   INTEGER,           PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  nn_trcdmp_bdy        !: =T Tracer damping
-   ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp
-   TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process)
-#endif
 
    !!----------------------------------------------------------------------
@@ -246,16 +213,4 @@
          &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       &
          &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       & 
-! --->>> FABM
-!!#if defined key_my_trc
-! FABM <<<---
-! +++>>> FABM
-#if defined key_fabm
-! FABM <<<+++
-         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       &
-#endif
-#if defined key_bdy
-         &      cn_trc_dflt(nb_bdy)   , cn_trc(nb_bdy)        , nn_trcdmp_bdy(nb_bdy) ,       &
-         &      trcdta_bdy(jptra,nb_bdy)                                              ,       &
-#endif
          &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )  
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 10251)
@@ -4,12 +4,10 @@
    !! TOP :  module for passive tracer boundary conditions
    !!=====================================================================
-   !! History :  3.5 !  2014-04  (M. Vichi, T. Lovato)  Original
-   !!            3.6 !  2015-03  (T . Lovato) Revision and BDY support
-   !!----------------------------------------------------------------------
-#if defined key_top
+   !!----------------------------------------------------------------------
+#if  defined key_top 
    !!----------------------------------------------------------------------
    !!   'key_top'                                                TOP model 
    !!----------------------------------------------------------------------
-   !!   trc_bc       : read and time interpolated tracer Boundary Conditions
+   !!   trc_dta    : read and time interpolated passive tracer data
    !!----------------------------------------------------------------------
    USE par_trc       !  passive tracers parameters
@@ -19,7 +17,4 @@
    USE lib_mpp       !  MPP library
    USE fldread       !  read input fields
-#if defined key_bdy
-   USE bdy_oce, only: nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out
-#endif
 
    IMPLICIT NONE
@@ -29,22 +24,24 @@
    PUBLIC   trc_bc_read    ! called in trcstp.F90 or within
 
-   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc    ! number of tracers with open BC
-   INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc    ! number of tracers with surface BC
-   INTEGER  , SAVE, PUBLIC                             :: nb_trccbc    ! number of tracers with coastal BC
+   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc   ! number of tracers with open BC
+   INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc   ! number of tracers with surface BC
+   INTEGER  , SAVE, PUBLIC                             :: nb_trccbc   ! number of tracers with coastal BC
    INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indobc ! index of tracer with OBC data
    INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indsbc ! index of tracer with SBC data
    INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indcbc ! index of tracer with CBC data
-   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac    ! multiplicative factor for SBC tracer values
-   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc    ! structure of data input SBC (file informations, fields read)
-   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac    ! multiplicative factor for CBC tracer values
-   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc    ! structure of data input CBC (file informations, fields read)
-   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:)  :: rf_trofac    ! multiplicative factor for OBCtracer values
-   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET  :: sf_trcobc    ! structure of data input OBC (file informations, fields read)
-   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:,:) :: nbmap_ptr   ! array of pointers to nbmap
+   INTEGER  , SAVE, PUBLIC                             :: ntra_obc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking
+   INTEGER  , SAVE, PUBLIC                             :: ntra_sbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking
+   INTEGER  , SAVE, PUBLIC                             :: ntra_cbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking
+   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac   ! multiplicative factor for OBCtracer values
+   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcobc   ! structure of data input OBC (file informations, fields read)
+   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac   ! multiplicative factor for SBC tracer values
+   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc   ! structure of data input SBC (file informations, fields read)
+   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac   ! multiplicative factor for CBC tracer values
+   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc   ! structure of data input CBC (file informations, fields read)
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -63,15 +60,12 @@
       !
       INTEGER,INTENT(IN) :: ntrc                           ! number of tracers
-      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices
+      INTEGER            :: jl, jn                         ! dummy loop indices
       INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers
-      INTEGER            :: ios                            ! Local integer output status for namelist read
-      INTEGER            :: nblen, igrd                    ! support arrays for BDY
+      INTEGER            ::  ios                           ! Local integer output status for namelist read
       CHARACTER(len=100) :: clndta, clntrc
       !
-      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc
-
+      CHARACTER(len=100) :: cn_dir
       TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read
-      TYPE(FLD_N), DIMENSION(jpmaxtrc,2) :: sn_trcobc  ! open
-      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc2   ! to read in multiple (2) open bdy
+      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open
       TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcsbc    ! surface
       TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trccbc    ! coastal
@@ -80,16 +74,8 @@
       REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values
       !!
-      NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc2, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac
-#if defined key_bdy
-      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy
-#endif
+      NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 
       !!----------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('trc_bc_init')
       !
-      IF( lwp ) THEN
-         WRITE(numout,*) ' '
-         WRITE(numout,*) 'trc_bc_init : Tracers Boundary Conditions (BC)'
-         WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
       !  Initialisation and local array allocation
       ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0  
@@ -121,5 +107,31 @@
       n_trc_indcbc(:) = 0
       !
-      ! Read Boundary Conditions Namelists
+      DO jn = 1, ntrc
+         IF( ln_trc_obc(jn) ) THEN
+             nb_trcobc       = nb_trcobc + 1 
+             n_trc_indobc(jn) = nb_trcobc 
+         ENDIF
+         IF( ln_trc_sbc(jn) ) THEN
+             nb_trcsbc       = nb_trcsbc + 1
+             n_trc_indsbc(jn) = nb_trcsbc
+         ENDIF
+         IF( ln_trc_cbc(jn) ) THEN
+             nb_trccbc       = nb_trccbc + 1
+             n_trc_indcbc(jn) = nb_trccbc
+         ENDIF
+      ENDDO
+      ntra_obc = MAX( 1, nb_trcobc )   ! To avoid compilation error with bounds checking
+      IF( lwp ) WRITE(numout,*) ' '
+      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc
+      IF( lwp ) WRITE(numout,*) ' '
+      ntra_sbc = MAX( 1, nb_trcsbc )   ! To avoid compilation error with bounds checking
+      IF( lwp ) WRITE(numout,*) ' '
+      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc
+      IF( lwp ) WRITE(numout,*) ' '
+      ntra_cbc = MAX( 1, nb_trccbc )   ! To avoid compilation error with bounds checking
+      IF( lwp ) WRITE(numout,*) ' '
+      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc
+      IF( lwp ) WRITE(numout,*) ' '
+
       REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure
       READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901)
@@ -127,163 +139,58 @@
 
       REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure
-#if defined key_bdy
-      DO ib = 1, nb_bdy
-#endif
-        READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 )
-902     IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp )
-        IF(lwm) WRITE ( numont, namtrc_bc )
-#if defined key_bdy
-        sn_trcobc(:,ib)=sn_trcobc2(:)
-      ENDDO
-#endif
-
-#if defined key_bdy
-      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure
-      READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903)
-903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure
-      READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 )
-904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_bdy )
-      ! setup up preliminary informations for BDY structure
-      DO jn = 1, ntrc
-         DO ib = 1, nb_bdy
-            ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml)
-            IF ( ln_trc_obc(jn) ) THEN
-               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) )
-            ELSE
-               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) )
-            ENDIF
-            ! set damping use in BDY data structure
-            trcdta_bdy(jn,ib)%dmp = .false.
-            IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true.
-            IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true.
-            IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  &
-                & CALL ctl_stop( 'Use FRS OR relaxation' )
-            IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            &
-                & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' )
+      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_bc )
+
+      ! print some information for each 
+      IF( lwp ) THEN
+         DO jn = 1, ntrc
+            IF( ln_trc_obc(jn) )  THEN    
+               clndta = TRIM( sn_trcobc(jn)%clvar ) 
+               IF(lwp) WRITE(numout,*) 'Preparing to read OBC data file for passive tracer number :', jn, ' name : ', clndta, & 
+               &               ' multiplicative factor : ', rn_trofac(jn)
+            ENDIF
+            IF( ln_trc_sbc(jn) )  THEN    
+               clndta = TRIM( sn_trcsbc(jn)%clvar ) 
+               IF(lwp) WRITE(numout,*) 'Preparing to read SBC data file for passive tracer number :', jn, ' name : ', clndta, & 
+               &               ' multiplicative factor : ', rn_trsfac(jn)
+            ENDIF
+            IF( ln_trc_cbc(jn) )  THEN    
+               clndta = TRIM( sn_trccbc(jn)%clvar ) 
+               IF(lwp) WRITE(numout,*) 'Preparing to read CBC data file for passive tracer number :', jn, ' name : ', clndta, & 
+               &               ' multiplicative factor : ', rn_trcfac(jn)
+            ENDIF
+         END DO
+      ENDIF
+      !
+      ! The following code is written this way to reduce memory usage and repeated for each boundary data
+      ! MAV: note that this is just a placeholder and the dimensions must be changed according to 
+      !      what will be done with BDY. A new structure will probably need to be included
+      !
+      ! OPEN Lateral boundary conditions
+      IF( nb_trcobc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
+         ALLOCATE( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 )
+         IF( ierr1 > 0 ) THEN
+            CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcobc structure' )   ;   RETURN
+         ENDIF
+         !
+         DO jn = 1, ntrc
+            IF( ln_trc_obc(jn) ) THEN      ! update passive tracers arrays with input data read from file
+               jl = n_trc_indobc(jn)
+               slf_i(jl)    = sn_trcobc(jn)
+               rf_trofac(jl) = rn_trofac(jn)
+                                            ALLOCATE( sf_trcobc(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
+               IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+               IF( ierr2 + ierr3 > 0 ) THEN
+                 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN
+               ENDIF
+            ENDIF
+            !   
          ENDDO
-      ENDDO
-
-#else
-      ! Force all tracers OBC to false if bdy not used
-      ln_trc_obc = .false.
-#endif
-      ! compose BC data indexes
-      DO jn = 1, ntrc
-         IF( ln_trc_obc(jn) ) THEN
-             nb_trcobc       = nb_trcobc + 1  ; n_trc_indobc(jn) = nb_trcobc
-         ENDIF
-         IF( ln_trc_sbc(jn) ) THEN
-             nb_trcsbc       = nb_trcsbc + 1  ; n_trc_indsbc(jn) = nb_trcsbc
-         ENDIF
-         IF( ln_trc_cbc(jn) ) THEN
-             nb_trccbc       = nb_trccbc + 1  ; n_trc_indcbc(jn) = nb_trccbc
-         ENDIF
-      ENDDO
-
-      ! Print summmary of Boundary Conditions
-      IF( lwp ) THEN
-         WRITE(numout,*) ' '
-         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc
-         IF ( nb_trcsbc > 0 ) THEN
-            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. '
-            DO jn = 1, ntrc
-               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn)
-            ENDDO
-         ENDIF
-         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc)
-
-         WRITE(numout,*) ' '
-         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc
-         IF ( nb_trccbc > 0 ) THEN
-            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. '
-            DO jn = 1, ntrc
-               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn)
-            ENDDO
-         ENDIF
-         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc)
-
-         WRITE(numout,*) ' '
-         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc
-#if defined key_bdy
-         IF ( nb_trcobc > 0 ) THEN
-            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings'
-            DO jn = 1, ntrc
-               DO ib = 1, nb_bdy
-                 IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn,ib)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc)
-               ENDDO
-               !IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn,ib)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
-               IF ( .NOT. ln_trc_obc(jn) )  WRITE(numout, 9002) jn, 'Set data to IC and use default condition', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
-            ENDDO
-            WRITE(numout,*) ' '
-            DO ib = 1, nb_bdy
-                IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers'
-                IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided'
-                IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers'
-                IF (nn_trcdmp_bdy(ib) .GT. 0) THEN
-                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : '
-                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days'
-                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days'
-                ENDIF
-            ENDDO
-         ENDIF
-#endif
-         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc)
-      ENDIF
-9001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13)
-9002  FORMAT(2x,i5, 3x, a41, 3x, 10a13)
-9003  FORMAT(a, i5, a)
-
-      !
-#if defined key_bdy
-      ! OPEN Lateral boundary conditions
-      IF( nb_trcobc > 0 ) THEN 
-         ALLOCATE ( sf_trcobc(nb_trcobc,nb_bdy), rf_trofac(nb_trcobc,nb_bdy), nbmap_ptr(nb_trcobc,nb_bdy), STAT=ierr1 )
-         IF( ierr1 > 0 ) THEN
-            CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' )   ;   RETURN
-         ENDIF
-
-         igrd = 1                       ! Everything is at T-points here
-
-         DO ib = 1, nb_bdy
-            DO jn = 1, ntrc
-
-               nblen = idx_bdy(ib)%nblen(igrd)
-
-               IF ( ln_trc_obc(jn) ) THEN
-               ! Initialise from external data
-                  jl = n_trc_indobc(jn)
-                  slf_i(jl)    = sn_trcobc(jn,ib)
-                  rf_trofac(jl,ib) = rn_trofac(jn)
-                                               ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk)   , STAT=ierr2 )
-                  IF( sn_trcobc(jn,ib)%ln_tint )  ALLOCATE( sf_trcobc(jl,ib)%fdta(nblen,1,jpk,2) , STAT=ierr3 )
-                  IF( ierr2 + ierr3 > 0 ) THEN
-                    CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN
-                  ENDIF
-                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:)
-                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl,ib)
-                  ! create OBC mapping array
-                  nbmap_ptr(jl,ib)%ptr => idx_bdy(ib)%nbmap(:,igrd)
-                  nbmap_ptr(jl,ib)%ll_unstruc = ln_coords_file(igrd)
-               ELSE
-               ! Initialise obc arrays from initial conditions
-                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) )
-                  DO ibd = 1, nblen
-                     DO ik = 1, jpkm1
-                        ii = idx_bdy(ib)%nbi(ibd,igrd)
-                        ij = idx_bdy(ib)%nbj(ibd,igrd)
-                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik)
-                     END DO
-                  END DO
-                  trcdta_bdy(jn,ib)%rn_fac = 1._wp
-               ENDIF
-            ENDDO
-            CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' )
-         ENDDO
-
-      ENDIF
-#endif
+         !                         ! fill sf_trcdta with slf_i and control print
+         CALL fld_fill( sf_trcobc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' )
+         !
+      ENDIF
+      !
       ! SURFACE Boundary conditions
       IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
@@ -307,5 +214,5 @@
          ENDDO
          !                         ! fill sf_trcsbc with slf_i and control print
-         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' )
+         CALL fld_fill( sf_trcsbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' )
          !
       ENDIF
@@ -332,5 +239,5 @@
          ENDDO
          !                         ! fill sf_trccbc with slf_i and control print
-         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' )
+         CALL fld_fill( sf_trccbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' )
          !
       ENDIF
@@ -342,5 +249,5 @@
 
 
-   SUBROUTINE trc_bc_read(kt, jit)
+   SUBROUTINE trc_bc_read(kt)
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_bc_init  ***
@@ -357,66 +264,33 @@
       !! * Arguments
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option)
-      INTEGER :: ib
+
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('trc_bc_read')
 
-      IF( kt == nit000 .AND. lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.'
-         WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
-
-      IF ( PRESENT(jit) ) THEN 
-
-#ifdef key_bdy
-         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step)
-         IF( nb_trcobc > 0 ) THEN
-           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
-           DO ib = 1,nb_bdy
-             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kit=jit, kt_offset=+1)
-           ENDDO
-         ENDIF
-#endif
-
-         ! SURFACE boundary conditions
-         IF( nb_trcsbc > 0 ) THEN
-           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
-           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit)
-         ENDIF
-
-         ! COASTAL boundary conditions
-         IF( nb_trccbc > 0 ) THEN
-           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
-           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit)
-         ENDIF
-
-      ELSE
-
-#ifdef key_bdy
-         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step)
-         IF( nb_trcobc > 0 ) THEN
-           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
-           DO ib = 1,nb_bdy
-             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kt_offset=+1)
-           ENDDO
-         ENDIF
-#endif
-
-         ! SURFACE boundary conditions
-         IF( nb_trcsbc > 0 ) THEN
-           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
-           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc)
-         ENDIF
-
-         ! COASTAL boundary conditions
-         IF( nb_trccbc > 0 ) THEN
-           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
-           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc)
-         ENDIF
-
-      ENDIF
-
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      ! OPEN boundary conditions: DOES NOT WORK. Waiting for stable BDY
+      IF( nb_trcobc > 0 ) THEN
+        if (lwp) write(numout,'(a,i5,a,i5)') '   reading OBC data for ', nb_trcobc ,' variables at step ', kt
+        CALL fld_read(kt,1,sf_trcobc)
+        ! vertical interpolation on s-grid and partial step to be added
+      ENDIF
+
+      ! SURFACE boundary conditions       
+      IF( nb_trcsbc > 0 ) THEN
+        if (lwp) write(numout,'(a,i5,a,i5)') '   reading SBC data for ', nb_trcsbc ,' variables at step ', kt
+        CALL fld_read(kt,1,sf_trcsbc)
+      ENDIF
+
+      ! COASTAL boundary conditions       
+      IF( nb_trccbc > 0 ) THEN
+        if (lwp) write(numout,'(a,i5,a,i5)') '   reading CBC data for ', nb_trccbc ,' variables at step ', kt
+        CALL fld_read(kt,1,sf_trccbc)
+      ENDIF   
       !
       IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read')
@@ -429,10 +303,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
-   SUBROUTINE trc_bc_init( ntrc )        ! Empty routine
-      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers
-      WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_bc_init
-
    SUBROUTINE trc_bc_read( kt )        ! Empty routine
       WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90	(revision 10250)
+++ 	(revision )
@@ -1,305 +1,0 @@
-MODULE trcbdy
-   !!======================================================================
-   !!                       ***  MODULE  bdytrc  ***
-   !! Ocean tracers:   Apply boundary conditions for tracers in TOP component
-   !!======================================================================
-   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
-   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
-   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
-   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
-   !!            3.6  !  2015     (T. Lovato) Adapt BDY for tracers in TOP component
-   !!----------------------------------------------------------------------
-#if defined key_bdy && key_top
-   !!----------------------------------------------------------------------
-   !!   'key_bdy'                     Unstructured Open Boundary Conditions
-   !!----------------------------------------------------------------------
-   !!   trc_bdy            : Apply open boundary conditions to T and S
-   !!   trc_bdy_frs        : Apply Flow Relaxation Scheme
-   !!----------------------------------------------------------------------
-   USE timing                       ! Timing
-   USE oce_trc                      ! ocean dynamics and tracers variables
-   USE par_trc
-   USE trc                          ! ocean space and time domain variables 
-   USE bdylib                       ! for orlanski library routines
-   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link)
-   USE in_out_manager               ! I/O manager
-   USE bdy_oce, only: idx_bdy, OBC_INDEX, BDYTMASK, lk_bdy       ! ocean open boundary conditions
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_bdy      ! routine called in trcnxt.F90 
-   PUBLIC trc_bdy_dmp  ! routine called in trcstp.F90 
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE trc_bdy( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  SUBROUTINE trc_bdy  ***
-      !!
-      !! ** Purpose : - Apply open boundary conditions for tracers in TOP component
-      !!                and scale the tracer data
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) :: kt     ! Main time step counter
-      !!
-      INTEGER               :: ib_bdy, jn ! Loop indeces
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('trc_bdy')
-      !
-      DO jn = 1, jptra
-         DO ib_bdy=1, nb_bdy
-
-            SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc )
-            CASE('none')
-               CYCLE
-            CASE('frs')
-               CALL bdy_trc_frs( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt )
-            CASE('specified')
-               CALL bdy_trc_spe( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt )
-            CASE('neumann')
-               CALL bdy_trc_nmn( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt )
-            CASE('orlanski')
-               CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.false. )
-            CASE('orlanski_npo')
-               CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.true. )
-            CASE DEFAULT
-               CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
-            END SELECT
-
-            ! Boundary points should be updated
-            CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy )
-
-         ENDDO
-      ENDDO
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy')
-
-   END SUBROUTINE trc_bdy
-
-   SUBROUTINE bdy_trc_frs( jn, idx, dta, kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  SUBROUTINE bdy_trc_frs  ***
-      !!                    
-      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.
-      !! 
-      !! Reference : Engedahl H., 1995, Tellus, 365-382.
-      !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      INTEGER,         INTENT(in) ::   jn   ! Tracer index
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      !! 
-      REAL(wp) ::   zwgt           ! boundary weight
-      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
-      INTEGER  ::   ii, ij         ! 2D addresses
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_trc_frs')
-      ! 
-      igrd = 1                       ! Everything is at T-points here
-      DO ib = 1, idx%nblen(igrd)
-         DO ik = 1, jpkm1
-            ii = idx%nbi(ib,igrd)
-            ij = idx%nbj(ib,igrd)
-            zwgt = idx%nbw(ib,igrd)
-            tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) + zwgt * ( ( dta%trc(ib,ik) * dta%rn_fac)  & 
-                        &  - tra(ii,ij,ik,jn) ) ) * tmask(ii,ij,ik)
-         END DO
-      END DO 
-      !
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_frs')
-      !
-   END SUBROUTINE bdy_trc_frs
-  
-   SUBROUTINE bdy_trc_spe( jn, idx, dta, kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  SUBROUTINE bdy_trc_frs  ***
-      !!                    
-      !! ** Purpose : Apply a specified value for tracers at open boundaries.
-      !! 
-      !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      INTEGER,         INTENT(in) ::   jn   ! Tracer index
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      !! 
-      REAL(wp) ::   zwgt           ! boundary weight
-      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
-      INTEGER  ::   ii, ij         ! 2D addresses
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_trc_spe')
-      !
-      igrd = 1                       ! Everything is at T-points here
-      DO ib = 1, idx%nblenrim(igrd)
-         ii = idx%nbi(ib,igrd)
-         ij = idx%nbj(ib,igrd)
-         DO ik = 1, jpkm1
-            tra(ii,ij,ik,jn) = dta%trc(ib,ik) * dta%rn_fac * tmask(ii,ij,ik)
-         END DO
-      END DO
-      !
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_spe')
-      !
-   END SUBROUTINE bdy_trc_spe
-
-   SUBROUTINE bdy_trc_nmn( jn, idx, dta, kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  SUBROUTINE bdy_trc_nmn  ***
-      !!                    
-      !! ** Purpose : Duplicate the value for tracers at open boundaries.
-      !! 
-      !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      INTEGER,         INTENT(in) ::   jn   ! Tracer index
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      !! 
-      REAL(wp) ::   zcoef, zcoef1, zcoef2           ! boundary weight
-      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
-      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_trc_nmn')
-      !
-      igrd = 1                       ! Everything is at T-points here
-      DO ib = 1, idx%nblenrim(igrd)
-         ii = idx%nbi(ib,igrd)
-         ij = idx%nbj(ib,igrd)
-         DO ik = 1, jpkm1
-            ! search the sense of the gradient
-            zcoef1 = bdytmask(ii-1,ij  )*tmask(ii-1,ij,ik) +  bdytmask(ii+1,ij  )*tmask(ii+1,ij,ik)
-            zcoef2 = bdytmask(ii  ,ij-1)*tmask(ii,ij-1,ik) +  bdytmask(ii  ,ij+1)*tmask(ii,ij+1,ik)
-            IF ( nint(zcoef1+zcoef2) == 0) THEN
-               ! corner
-               zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik)
-               IF (zcoef > .5_wp) THEN ! Only set not isolated points.
-                 tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik) + &
-                   &              tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik) + &
-                   &              tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik) + &
-                   &              tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik)
-                 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / zcoef ) * tmask(ii,ij,ik)
-               ENDIF
-            ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN
-               ! oblique corner
-               zcoef = tmask(ii-1,ij,ik)*bdytmask(ii-1,ij  ) + tmask(ii+1,ij,ik)*bdytmask(ii+1,ij  ) + &
-                  &  tmask(ii,ij-1,ik)*bdytmask(ii,ij -1 ) +  tmask(ii,ij+1,ik)*bdytmask(ii,ij+1  )
-               tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik)*bdytmask(ii-1,ij  ) + &
-                  &              tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik)*bdytmask(ii+1,ij  )  + &
-                  &              tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik)*bdytmask(ii,ij -1 ) + &
-                  &              tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik)*bdytmask(ii,ij+1  )
- 
-               tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX(1._wp, zcoef) ) * tmask(ii,ij,ik)
-            ELSE
-               ip = nint(bdytmask(ii+1,ij  )*tmask(ii+1,ij,ik) - bdytmask(ii-1,ij  )*tmask(ii-1,ij,ik))
-               jp = nint(bdytmask(ii  ,ij+1)*tmask(ii,ij+1,ik) - bdytmask(ii  ,ij-1)*tmask(ii,ij-1,ik))
-               tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik) * tmask(ii,ij,ik)
-            ENDIF
-         END DO
-      END DO
-      !
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_nmn')
-      !
-   END SUBROUTINE bdy_trc_nmn
- 
-
-   SUBROUTINE bdy_trc_orlanski( jn, idx, dta, ll_npo )
-      !!----------------------------------------------------------------------
-      !!                 ***  SUBROUTINE bdy_trc_orlanski  ***
-      !!             
-      !!              - Apply Orlanski radiation to tracers of TOP component. 
-      !!              - Wrapper routine for bdy_orlanski_3d
-      !! 
-      !!
-      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
-      !!----------------------------------------------------------------------
-      INTEGER,                      INTENT(in) ::   jn      ! Tracer index
-      TYPE(OBC_INDEX),              INTENT(in) ::   idx     ! OBC indices
-      TYPE(OBC_DATA),               INTENT(in) ::   dta     ! OBC external data
-      LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version
-
-      INTEGER  ::   igrd                                    ! grid index
-      !!----------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_trc_orlanski')
-      !
-      igrd = 1      ! Orlanski bc on tracers; 
-      !            
-      CALL bdy_orlanski_3d( idx, igrd, trb(:,:,:,jn), tra(:,:,:,jn), (dta%trc * dta%rn_fac), ll_npo )
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_orlanski')
-      !
-
-   END SUBROUTINE bdy_trc_orlanski
-
-   SUBROUTINE trc_bdy_dmp( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  SUBROUTINE trc_bdy_dmp  ***
-      !!                    
-      !! ** Purpose : Apply damping for tracers at open boundaries.
-      !!             It currently applies the damping to all tracers!!!
-      !! 
-      !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      !! 
-      INTEGER  ::   jn             ! Tracer index
-      REAL(wp) ::   zwgt           ! boundary weight
-      REAL(wp) ::   zta, zsa, ztime
-      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
-      INTEGER  ::   ii, ij         ! 2D addresses
-      INTEGER  ::   ib_bdy         ! Loop index
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('trc_bdy_dmp')
-      !
-      DO jn = 1, jptra
-         DO ib_bdy=1, nb_bdy
-            IF ( trcdta_bdy(jn, ib_bdy)%dmp ) THEN
-               igrd = 1                       ! Everything is at T-points here
-               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
-                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
-                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-                  zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
-                  DO ik = 1, jpkm1
-                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik)
-                     tra(ii,ij,ik,jn) = tra(ii,ij,ik,jn) + zta
-                  END DO
-               END DO
-            ENDIF
-         ENDDO
-      ENDDO
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy_dmp')
-      !
-   END SUBROUTINE trc_bdy_dmp
- 
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module                   NO Unstruct Open Boundary Conditions
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_bdy(kt)      ! Empty routine
-      WRITE(*,*) 'trc_bdy: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_bdy
-
-   SUBROUTINE trc_bdy_dmp(kt)      ! Empty routine
-      WRITE(*,*) 'trc_bdy_dmp: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_bdy_dmp
-
-#endif
-
-   !!======================================================================
-END MODULE trcbdy
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 10251)
@@ -9,5 +9,4 @@
    !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation 
    !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models
-   !!            3.6   !  2015-03  (T. Lovato) revision of code log info
    !!----------------------------------------------------------------------
 #if  defined key_top 
@@ -73,10 +72,4 @@
       IF( nn_timing == 1 )  CALL timing_start('trc_dta_init')
       !
-      IF( lwp ) THEN
-         WRITE(numout,*) ' '
-         WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)'
-         WRITE(numout,*) '  ~~~~~~~~~~~ '
-      ENDIF
-      !
       !  Initialisation
       ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0  
@@ -84,5 +77,5 @@
       ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
       IF( ierr0 > 0 ) THEN
-         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN
+         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN
       ENDIF
       nb_trcdta      = 0
@@ -104,9 +97,9 @@
       REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data
       READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp )
 
       REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data
       READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp )
       IF(lwm) WRITE ( numont, namtrc_dta )
 
@@ -116,14 +109,12 @@
                clndta = TRIM( sn_trcdta(jn)%clvar ) 
                clntrc = TRIM( ctrcnm   (jn)       ) 
-               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
                zfact  = rn_trfac(jn)
                IF( clndta /=  clntrc ) THEN 
-                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   &
-                  &              'Input name of data file : '//TRIM(clndta)//   &
-                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ')
+                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   &
+                  &              'the variable name in the data file : '//clndta//   & 
+                  &              '  must be the same than the name of the passive tracer : '//clntrc//' ')
                ENDIF
-               WRITE(numout,*) ' '
-               WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', &
-               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
+               WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 
+               &               ' multiplicative factor : ', zfact
             ENDIF
          END DO
@@ -133,5 +124,5 @@
          ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
          IF( ierr1 > 0 ) THEN
-            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN
+            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
          ENDIF
          !
@@ -144,5 +135,5 @@
                IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
                IF( ierr2 + ierr3 > 0 ) THEN
-                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN
+                 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN
                ENDIF
             ENDIF
@@ -150,5 +141,5 @@
          ENDDO
          !                         ! fill sf_trcdta with slf_i and control print
-         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' )
+         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' )
          !
       ENDIF
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 10251)
@@ -24,8 +24,4 @@
    USE trcini_c14b     ! C14 bomb initialisation
    USE trcini_my_trc   ! MY_TRC   initialisation
-   ! +++>>> FABM
-   USE trcsms_fabm     ! FABM initialisation
-   USE trcini_fabm     ! FABM initialisation
-   ! FABM <<<FABM
    USE trcdta          ! initialisation from files
    USE daymod          ! calendar manager
@@ -36,5 +32,4 @@
    USE sbc_oce
    USE trcice          ! tracers in sea ice
-   USE trcbc,   only : trc_bc_init ! generalized Boundary Conditions
  
    IMPLICIT NONE
@@ -74,8 +69,4 @@
       IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
       IF(lwp) WRITE(numout,*) '~~~~~~~'
-      ! +++>>> FABM
-      ! Allow FABM to update numbers of biogeochemical tracers, diagnostics (jptra etc.)
-      IF( lk_fabm ) CALL nemo_fabm_init
-      ! FABM <<<+++
 
       CALL top_alloc()              ! allocate TOP arrays
@@ -110,7 +101,4 @@
       IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
       IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
-      ! +++>>> FABM
-      IF( lk_fabm    )       CALL trc_ini_fabm         ! FABM    tracers
-      ! FABM <<<+++
 
       CALL trc_ice_ini                                 ! Tracers in sea ice
@@ -122,5 +110,4 @@
       ENDIF
 
-      ! Initialisation of tracers Initial Conditions
       IF( ln_trcdta )      CALL trc_dta_init(jptra)
 
@@ -157,17 +144,4 @@
         ! 
       ENDIF
-      ! --->>> FABM
-! Initialisation of tracers Boundary Conditions  - here so that you can use initial condition as boundary
-      !IF( lk_my_trc )     CALL trc_bc_init(jptra)
-      ! FABM <<<---
-      ! FABM +++>>>
-! Initialisation of FABM diagnostics and tracer boundary conditions (so that you can use initial condition as boundary)
-      IF( lk_fabm )     THEN
-          wndm=0._wp !uninitiased field at this point
-          qsr=0._wp !uninitiased field at this point
-          CALL compute_fabm ! only needed to set-up diagnostics
-          CALL trc_bc_init(jptra)
-      ENDIF
-      ! FABM <<<+++
  
       tra(:,:,:,:) = 0._wp
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 10251)
@@ -25,7 +25,4 @@
    USE trcnam_c14b       ! C14 SMS namelist
    USE trcnam_my_trc     ! MY_TRC SMS namelist
-   ! +++>>> FABM
-   USE trcnam_fabm       ! FABM SMS namelist
-   ! FABM <<<+++
    USE trd_oce       
    USE trdtrc_oce
@@ -37,10 +34,4 @@
    PUBLIC trc_nam_run  ! called in trcini
    PUBLIC trc_nam      ! called in trcini
-   PUBLIC trc_nam_dia
-#if defined key_trdmxl_trc  || defined key_trdtrc
-   NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
-      &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, &
-      &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
-#endif
 
    !! * Substitutions
@@ -66,8 +57,4 @@
       !!---------------------------------------------------------------------
       INTEGER  ::   jn                  ! dummy loop indice
-#if defined key_trdmxl_trc  || defined key_trdtrc
-      INTEGER :: ios
-#endif
-
       !                                        !   Parameters of the run 
       IF( .NOT. lk_offline ) CALL trc_nam_run
@@ -181,10 +168,4 @@
       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
       ENDIF
-
-      ! +++>>> FABM
-      IF( lk_fabm    ) THEN   ;   CALL trc_nam_fabm        ! FABM tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          FABM not used'
-      ENDIF
-      ! FABM <<<+++
       !
    END SUBROUTINE trc_nam
@@ -206,5 +187,5 @@
 
 
-      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists'
+      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
       IF(lwp) WRITE(numout,*) '~~~~~~~'
 
@@ -253,10 +234,5 @@
 
       ! --- Namelist declarations --- !
-      ! --->>> FABM
-      !TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer
-      ! FABM <<<--- 
-      ! +++>>> FABM
-      TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer
-      ! FABM <<<+++ 
+      TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer
       NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
 
@@ -302,12 +278,7 @@
       !!
       !!---------------------------------------------------------------------
-      ! --->>> FABM
-      !TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput
-      ! FABM <<<---
-      ! +++>>> FABM
-      TYPE(PTRACER), DIMENSION(jpmaxtrc) :: sn_tracer  ! type of tracer for saving if not key_iomput
-      ! FABM <<<+++
-      !!
-      NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo
+      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput
+      !!
+      NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo
   
       INTEGER  ::   ios                 ! Local integer output status for namelist read
@@ -315,15 +286,7 @@
       !!---------------------------------------------------------------------
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists'
+      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
       IF(lwp) WRITE(numout,*) '~~~~~~~'
 
-      ! Initialise logical flags to .FALSE.:
-      sn_tracer(:)%llinit = .FALSE.
-      sn_tracer(:)%llsave = .FALSE.
-#ifdef key_fabm
-      sn_tracer(:)%llsbc = .FALSE.
-      sn_tracer(:)%llcbc = .FALSE.
-      sn_tracer(:)%llcbc = .FALSE.
-#endif
 
       REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
@@ -341,20 +304,7 @@
          ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  )
          ln_trc_ini(jn) =       sn_tracer(jn)%llinit
-! --->>> FABM
-!!#if defined key_my_trc
-! FABM <<<---
-! +++>>> FABM
-#if defined key_fabm
-! FABM <<<+++
-         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc
-         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc
-         ln_trc_obc(jn) =       sn_tracer(jn)%llobc
-#endif
          ln_trc_wri(jn) =       sn_tracer(jn)%llsave
       END DO
-     
-      ! +++>>> FABM
-      if (lk_fabm) CALL trc_nam_fabm_override
-      ! FABM <<<+++
+      
     END SUBROUTINE trc_nam_trc
 
@@ -372,7 +322,7 @@
       INTEGER ::  ierr
 #if defined key_trdmxl_trc  || defined key_trdtrc
-!     NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
-!        &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, &
-!        &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
+      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
+         &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, &
+         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
 #endif
       NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio
@@ -447,3 +397,3 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
-END MODULE trcnam
+END MODULE  trcnam
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 10251)
@@ -28,7 +28,4 @@
    USE iom
    USE daymod
-   ! +++>>> FABM
-   USE trcrst_fabm
-   ! FABM <<<+++
    IMPLICIT NONE
    PRIVATE
@@ -120,8 +117,4 @@
          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
       END DO
-      ! +++>>> FABM
-
-      IF (lk_fabm) CALL trc_rst_read_fabm
-      ! FABM <<<+++
       !
    END SUBROUTINE trc_rst_read
@@ -149,7 +142,4 @@
          CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
       END DO
-      ! +++>>> FABM
-      IF (lk_fabm) CALL trc_rst_wri_fabm(kt)
-      ! FABM <<<+++
       !
       IF( kt == nitrst ) THEN
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 10251)
@@ -19,7 +19,4 @@
    USE trcsms_c14b        ! C14b tracer 
    USE trcsms_my_trc      ! MY_TRC  tracers
-   ! +++>>>> FABM
-   USE trcsms_fabm        ! FABM tracers
-   ! FABM <<<+++
    USE prtctl_trc         ! Print control for debbuging
 
@@ -55,7 +52,4 @@
       IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14
       IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers
-      ! +++>>> FABM
-      IF( lk_fabm    )   CALL trc_sms_fabm ( kt )      ! FABM tracers
-      ! FABM <<<+++
 
       IF(ln_ctl) THEN      ! print mean trends (used for debugging)
@@ -81,3 +75,3 @@
 
    !!======================================================================
-END MODULE trcsms
+END MODULE  trcsms
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 10251)
@@ -32,5 +32,5 @@
    REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step
    REAL(wp) :: rdt_sampl
-   INTEGER  :: nb_rec_per_day
+   INTEGER  :: nb_rec_per_days
    INTEGER  :: isecfst, iseclast
    LOGICAL  :: llnew
@@ -100,8 +100,4 @@
          IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
          IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
-#if defined key_tracer_budget
-!slwa tracer budget
-         IF( lk_iomput ) CALL trc_wri (kt, 2) 
-#endif
          !
          IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
@@ -127,5 +123,5 @@
       !!               of diurnal cycle
       !!
-      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter 
+      !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter 
       !!              is greater than 1 hour ) and then, compute the  mean with 
       !!              a moving average over 24 hours. 
@@ -138,29 +134,21 @@
          IF( ln_cpl )  THEN  
             rdt_sampl = 86400. / ncpl_qsr_freq
-            nb_rec_per_day = ncpl_qsr_freq
+            nb_rec_per_days = ncpl_qsr_freq
          ELSE  
             rdt_sampl = MAX( 3600., rdt * nn_dttrc )
-            nb_rec_per_day = INT( 86400 / rdt_sampl )
+            nb_rec_per_days = INT( 86400 / rdt_sampl )
          ENDIF
          !
          IF( lwp ) THEN
             WRITE(numout,*) 
-            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day
+            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days
             WRITE(numout,*) 
          ENDIF
          !
-         !                                            !* Restart: read in restart file
-         IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean', ldstop = .FALSE. ) > 0 ) THEN 
-            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file'
-            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr
-         ELSE                                         !* no restart: set from nit000 values
-            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values'
-            qsr_mean(:,:) = qsr(:,:)
-         ENDIF
-         !
-         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
-         DO jn = 1, nb_rec_per_day
-             qsr_arr(:,:,jn) = qsr_mean(:,:)
+         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) )
+         DO jn = 1, nb_rec_per_days
+            qsr_arr(:,:,jn) = qsr(:,:)
          ENDDO
+         qsr_mean(:,:) = qsr(:,:)
          !
          isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
@@ -175,18 +163,11 @@
              &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '
           isecfst = iseclast
-          DO jn = 1, nb_rec_per_day - 1
+          DO jn = 1, nb_rec_per_days - 1
              qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
           ENDDO
-          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
-          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
+          qsr_arr (:,:,nb_rec_per_days) = qsr(:,:)
+          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days
       ENDIF
       !
-      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
-      ENDIF
-     !
    END SUBROUTINE trc_mean_qsr
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 10251)
@@ -20,5 +20,5 @@
 #endif
 #if defined key_zdfgls
-!   USE zdfgls, ONLY: en
+   USE zdfgls, ONLY: en
 #endif
    USE trabbl
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 10251)
@@ -21,7 +21,4 @@
    USE trcwri_c14b
    USE trcwri_my_trc
-   ! +++>>> FABM
-   USE trcwri_fabm
-   ! FABM <<<+++
 
    IMPLICIT NONE
@@ -35,9 +32,5 @@
 CONTAINS
 
-#if defined key_tracer_budget
-   SUBROUTINE trc_wri( kt , fl)  !slwa
-#else
    SUBROUTINE trc_wri( kt )
-#endif
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri  ***
@@ -46,9 +39,4 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in )     :: kt
-      ! +++>>>FABM
-#if defined key_tracer_budget
-      INTEGER, INTENT( in ), OPTIONAL     :: fl  ! slwa
-#endif
-      ! FABM <<<+++
       !
       INTEGER                   :: jn
@@ -71,20 +59,6 @@
       IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC
       IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14
-      ! +++>>>FABM
-#if defined key_tracer_budget
-      IF( PRESENT(fl) ) THEN
-         IF( lk_fabm    )   CALL trc_wri_fabm (kt, fl) ! MY_TRC  tracers for budget
-         IF( lk_my_trc ) CALL trc_wri_my_trc (kt, fl)    ! MY_TRC  tracers for budget
-      ELSE
-         IF( lk_fabm    )   CALL trc_wri_fabm (kt) ! FABM  tracers for budget
-         IF( lk_my_trc  )   CALL trc_wri_my_trc (kt) ! MY_TRC  tracers
-      ENDIF
-#else
-      IF( lk_fabm  )   CALL trc_wri_fabm (kt)     ! FABM  tracers
-      IF( lk_my_trc  )   CALL trc_wri_my_trc(kt)     ! MY_TRC  tracers
-#endif
-      ! FABM <<<+++
+      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers
       !
-
       IF( nn_timing == 1 )  CALL timing_stop('trc_wri')
       !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER	(revision 10251)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER	(revision 10251)
@@ -0,0 +1,74 @@
+#!/bin/bash 
+#!
+#PBS -N sette
+#PBS -e sette.$PBS_JOBID.err
+#PBS -o sette.$PBS_JOBID.out
+#PBS -l nodes=NODES:ppn=NPROC_NODE
+#PBS -q QUEUE
+#PBS -l walltime=03:00:00
+#PBS -l pvmem=5gb
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+#cbr export MPIRUN="mpiexec -n $OCEANCORES"
+export MPIRUN="mpirun -np $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  echo "Running time ${MPIRUN} ./opa"
+#
+  if [ MPI_FLAG == "yes" ]; then
+     mpirun -np $OCEANCORES ./opa
+  else
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 10250)
+++ 	(revision )
@@ -1,74 +1,0 @@
-#!/bin/bash 
-#!
-#PBS -N sette
-#PBS -e sette.$PBS_JOBID.err
-#PBS -o sette.$PBS_JOBID.out
-#PBS -l nodes=NODES:ppn=NPROC_NODE
-#PBS -q QUEUE
-#PBS -l walltime=03:00:00
-#PBS -l pmem=3gb
-
-#
-# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
-# (via sed operating on this template job file). 
-#
-  OCEANCORES=NPROCS
-  export SETTE_DIR=DEF_SETTE_DIR
-
-###############################################################
-#
-# set up mpp computing environment
-#
-# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
-#
-#cbr export MPIRUN="mpiexec -n $OCEANCORES"
-export MPIRUN="mpirun -np $OCEANCORES"
-
-#
-# load sette functions (only post_test_tidyup needed)
-#
-  . ${SETTE_DIR}/all_functions.sh
-#
-
-# Don't remove neither change the following line
-# BODY
-
-#
-# These variables are needed by post_test_tidyup function in all_functions.sh
-#
-  export EXE_DIR=DEF_EXE_DIR
-  export INPUT_DIR=DEF_INPUT_DIR
-  export CONFIG_DIR=DEF_CONFIG_DIR
-  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
-  export NEW_CONF=DEF_NEW_CONF
-  export CMP_NAM=DEF_CMP_NAM
-  export TEST_NAME=DEF_TEST_NAME
-#
-# end of set up
-###############################################################
-#
-# change to the working directory 
-#
-cd ${EXE_DIR}
-  echo Running on host `hostname`
-  echo Time is `date`
-  echo Directory is `pwd`
-# 
-#  Run the parallel MPI executable 
-#
-  echo "Running time ${MPIRUN} ./opa"
-#
-  if [ MPI_FLAG == "yes" ]; then
-     mpirun -np $OCEANCORES ./opa
-  else
-     time ./opa
-  fi
-
-#
-  post_test_tidyup
-
-# END_BODY
-# Don't remove neither change the previous line
-
-
-  exit
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/all_functions.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/all_functions.sh	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/all_functions.sh	(revision 10251)
@@ -79,5 +79,5 @@
 # ==========
 #
-# $Id$
+# $Id: all_functions.sh 4316 2013-11-26 15:43:56Z clevy $
 #
 #   * creation
@@ -286,30 +286,22 @@
         echo "################" >> ${SETTE_DIR}/output.sette
 
-        inxml=$1
         VAR_NAME=$( grep "^.*<.*file_definition.*type.*=" ${EXE_DIR}/$1 | sed -e "s% *\!.*%%" )
         if [ ${#VAR_NAME} -eq 0 ]
         then
-# This may have failed because the job is using XIOS_2.0 conventions and the file descriptions have moved to file_def.xml
-# Check again in case this is the case
-          VAR_NAME=$( grep "^.*<.*file_definition.*type.*=" ${EXE_DIR}/file_def.xml | sed -e "s% *\!.*%%" )
-          inxml="file_def.xml"
-          if [ ${#VAR_NAME} -eq 0 ]
-          then
                 echo "doing \"set_xio_file_type $@\". "
                 echo "xml_tag: file_definition with variable: type is empty"
-                echo "confirm that an appropriate file_definition is in \"${EXE_DIR}/$1\" or file_def.xml"
+                echo "confirm that an appropriate file_definition is in \"${EXE_DIR}/$1\" "
                 echo "exit"
                 echo "error in executing script : set_xio_file_type $@" >> ${SETTE_DIR}/output.sette
                 echo "....." >> ${SETTE_DIR}/output.sette
                 exit 1
-          fi
         fi
         if [ $2 == "one_file" ] 
         then
-           sed -e "s:multiple_file:one_file:" ${EXE_DIR}/$inxml > ${EXE_DIR}/$inxml.tmp
+           sed -e "s:multiple_file:one_file:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
         else
-           sed -e "s:one_file:multiple_file:" ${EXE_DIR}/$inxml > ${EXE_DIR}/$inxml.tmp
-        fi
-        mv ${EXE_DIR}/$inxml.tmp ${EXE_DIR}/$inxml
+           sed -e "s:one_file:multiple_file:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+        fi
+        mv ${EXE_DIR}/$1.tmp ${EXE_DIR}/$1
 
         echo "finished script : set_xio_file_type $@" >> ${SETTE_DIR}/output.sette
@@ -344,11 +336,6 @@
         if [ ${#VAR_NAME} -eq 0 ]
         then
-# This may have failed because the iodef file is using XIOS_2.0 syntax where "boolean" has reduced to "bool"
-# Check again in case this is the case
-          VAR_NAME=$( grep "^.*<.*variable id.*=.*using_server.*=.*bool" ${EXE_DIR}/$1 | sed -e "s% *\!.*%%" )
-           if [ ${#VAR_NAME} -eq 0 ]
-           then
                 echo "doing \"set_xio_using_server $@\". "
-                echo "xml_tag: "variable id=using_server" with either variable: boolean or bool is empty"
+                echo "xml_tag: "variable id=using_server" with variable: boolean is empty"
                 echo "confirm that an appropriate variable id is in \"${EXE_DIR}/$1\" "
                 echo "exit"
@@ -356,5 +343,4 @@
                 echo "....." >> ${SETTE_DIR}/output.sette
                 exit 1
-           fi
         fi
         if [ $2 == "false" ]
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/prepare_exe_dir.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 10251)
@@ -70,5 +70,5 @@
 export EXE_DIR=${CONFIG_DIR}/${NEW_CONF}/${TEST_NAME}
 
-cp -rL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
-if [ ! -f ${EXE_DIR}/file_def.xml ]; then cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml; fi
+cp -r ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
+cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml
 cd ${EXE_DIR}
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/prepare_job.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/prepare_job.sh	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/prepare_job.sh	(revision 10251)
@@ -186,5 +186,5 @@
   #  if [ ${MPI_FLAG} == "no" ] ; then
 		case ${COMPILER} in 
-			X64_MOBILIS*)
+			X64_MOBILIS)
                                 NB_REM=$( echo $NB_PROC $NXIO_PROC | awk '{print ( $1 + $2 ) % 16}')
 		        	if [ ${NB_REM} == 0 ] ; then
@@ -280,5 +280,5 @@
                                 fi
                                 ;;
-                        openmpi_NAVITI_MERCATOR)
+                        ifort_MERCATOR_CLUSTER)
                                 echo NB_PROCS ${NB_PROC}
                                 echo NB_NODES ${NB_NODES}
@@ -289,12 +289,12 @@
                                    NB_PROC_NODE=${NB_PROC}
                                 else
-                                   if [ ${NB_PROC} -le 16 ] ; then
+                                   if [ ${NB_PROC} -le 8 ] ; then
                                       NB_NODES=1
                                       QUEUE=mono
                                       NB_PROC_NODE=${NB_PROC}
                                    else
-                                      NB_NODES=$( echo $NB_PROC | awk '{print $1 - $1 % 16}'  | awk '{print $1 / 16 }')
+                                      NB_NODES=$( echo $NB_PROC | awk '{print $1 - $1 % 8}'  | awk '{print $1 / 8 }')
                                       QUEUE=multi
-                                      NB_PROC_NODE=16
+                                      NB_PROC_NODE=8
                                   fi
                                 fi
@@ -324,5 +324,8 @@
 
         case ${COMPILER} in
-              openmpi_NAVITI_MERCATOR)
+              ifort_MERCATOR_CLUSTER)
+                    #cat run_sette_test.job | sed -e"s:QUEUE:${QUEUE}:" > run_sette_test1.job 
+                    #cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" > run_sette_test1.job 
+                                                 #-e"s/NPROC_NODE/${NB_PROC_NODE}/" > run_sette_test1.job
                     cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" \
                                                  -e"s:QUEUE:${QUEUE}:" > run_sette_test1.job
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/sette.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/sette.sh	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/sette.sh	(revision 10251)
@@ -140,8 +140,7 @@
 # SAS             :11 & 12
 # ISOMIP          :13 & 14
-# ORCA2_LIM_OBS   :15
-# ORCA2_AGRIF_LIM :16 & 17 
-#                  18 & 19 
-for config in  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
+# ORCA2_LIM_OBS:   15
+# ORCA2_AGRIF_LIM :16
+for config in  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
 
 do
@@ -1238,10 +1237,8 @@
     set_namelist namelist_cfg jpnj 2
     set_namelist namelist_cfg jpnij 2
-#
     set_namelist 1_namelist_cfg nn_it000 1
     set_namelist 1_namelist_cfg nn_itend 150
     set_namelist 1_namelist_cfg ln_ctl .false.
     set_namelist 1_namelist_cfg ln_clobber .true.
-
     if [ ${USING_MPMD} == "yes" ] ; then
        set_xio_using_server iodef.xml true
@@ -1255,229 +1252,3 @@
 fi
 
-# test code corruption with AGRIF
-# Compile and run with or without AGRIF ORCA2_LIM
-if [ ${config} -eq 17 ] ;  then
-    # First run same as 16 but without zoom
-    export TEST_NAME="SHORT_NOZOOM"
-    cd ${CONFIG_DIR}
-    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_2_2 -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_agrif" del_key "key_zdftmx" del_key ${DEL_KEYS}
-    cd ${SETTE_DIR}
-    . ./param.cfg
-    . ./all_functions.sh
-    . ./prepare_exe_dir.sh
-    JOB_FILE=${EXE_DIR}/run_job.sh
-    NPROC=4
-    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
-    cd ${EXE_DIR}
-    set_namelist namelist_cfg nn_it000 1
-    set_namelist namelist_cfg nn_itend 75
-    set_namelist namelist_cfg ln_ctl .false.
-    set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg jpni 2
-    set_namelist namelist_cfg jpnj 2
-    set_namelist namelist_cfg jpnij 4
-# 
-#   Set the number of fine grids to zero:    
-    sed -i "1s/.*/0/" ${EXE_DIR}/AGRIF_FixedGrids.in
-
-    if [ ${USING_MPMD} == "yes" ] ; then
-       set_xio_using_server iodef.xml true
-    else
-       set_xio_using_server iodef.xml false
-    fi
-    cd ${SETTE_DIR}
-    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
-    cd ${SETTE_DIR}
-    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
-
-    export TEST_NAME="SHORT_NOAGRIF"
-    cd ${CONFIG_DIR}
-    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_2_2_NAG -r ORCA2_LIM -j 8 add_key "key_mpp_rep" del_key "key_zdftmx" del_key ${DEL_KEYS}
-    cd ${SETTE_DIR}
-    . ./param.cfg
-    . ./all_functions.sh
-    . ./prepare_exe_dir.sh
-    JOB_FILE=${EXE_DIR}/run_job.sh
-    NPROC=4
-    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
-    cd ${EXE_DIR}
-    set_namelist namelist_cfg nn_it000 1
-    set_namelist namelist_cfg nn_itend 75
-    set_namelist namelist_cfg ln_ctl .false.
-    set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg jpni 2
-    set_namelist namelist_cfg jpnj 2
-    set_namelist namelist_cfg jpnij 4
-#
-    if [ ${USING_MPMD} == "yes" ] ; then
-       set_xio_using_server iodef.xml true
-    else
-       set_xio_using_server iodef.xml false
-    fi
-    cd ${SETTE_DIR}
-    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
-    cd ${SETTE_DIR}
-    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
-
-fi
-
-## Restartability tests for ORCA2_LIM_AGRIF 
-if [ ${config} -eq 18 ] ;  then
-    export TEST_NAME="LONG"
-    cd ${CONFIG_DIR}
-    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_agrif" del_key "key_zdftmx" del_key ${DEL_KEYS}
-    cd ${SETTE_DIR}
-    . ./param.cfg
-    . ./all_functions.sh
-    . ./prepare_exe_dir.sh
-    JOB_FILE=${EXE_DIR}/run_job.sh
-    NPROC=4
-    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
-    cd ${EXE_DIR}
-    set_namelist namelist_cfg cn_exp \"O2LP_LONG\"
-    set_namelist namelist_cfg nn_it000 1
-    set_namelist namelist_cfg nn_itend 150
-    set_namelist namelist_cfg nn_stock 75
-    set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg jpni 2
-    set_namelist namelist_cfg jpnj 2
-    set_namelist namelist_cfg jpnij 4
-    set_namelist namelist_cfg nn_solv 2
-#
-    set_namelist 1_namelist_cfg cn_exp \"O2LP_LONG\"
-    set_namelist 1_namelist_cfg nn_it000 1
-    set_namelist 1_namelist_cfg nn_itend 300
-    set_namelist 1_namelist_cfg nn_stock 150
-    set_namelist 1_namelist_cfg ln_ctl .false.
-    set_namelist 1_namelist_cfg ln_clobber .true.
-#
-    if [ ${USING_MPMD} == "yes" ] ; then
-       set_xio_using_server iodef.xml true
-    else
-       set_xio_using_server iodef.xml false
-    fi
-    cd ${SETTE_DIR}
-    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
-    
-    cd ${SETTE_DIR}
-    export TEST_NAME="SHORT"
-    . ./prepare_exe_dir.sh
-    cd ${EXE_DIR}
-    set_namelist namelist_cfg cn_exp \"O2LP_SHORT\"
-    set_namelist namelist_cfg nn_it000 76
-    set_namelist namelist_cfg nn_itend 150
-    set_namelist namelist_cfg nn_stock 75
-    set_namelist namelist_cfg ln_rstart .true.
-    set_namelist namelist_cfg nn_rstctl 2
-    set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg jpni 2
-    set_namelist namelist_cfg jpnj 2
-
-    set_namelist namelist_cfg jpnij 4
-    set_namelist namelist_cfg nn_solv 2
-    set_namelist 1_namelist_cfg cn_exp \"O2LP_SHORT\"
-    set_namelist 1_namelist_cfg nn_it000 151
-    set_namelist 1_namelist_cfg nn_itend 300
-    set_namelist 1_namelist_cfg nn_stock 150
-    set_namelist 1_namelist_cfg ln_rstart .true.
-    set_namelist 1_namelist_cfg nn_rstctl 2
-    set_namelist 1_namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg cn_ocerst_in \"O2LP_LONG_00000075_restart\"
-    set_namelist namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000075_restart_ice\"
-
-    set_namelist 1_namelist_cfg cn_ocerst_in \"O2LP_LONG_00000150_restart\"
-
-    for (( i=1; i<=$NPROC; i++)) ; do
-        L_NPROC=$(( $i - 1 ))
-        L_NPROC=`printf "%04d\n" ${L_NPROC}`
-        ln -sf ../LONG/O2LP_LONG_00000075_restart_${L_NPROC}.nc .
-        ln -sf ../LONG/O2LP_LONG_00000075_restart_ice_${L_NPROC}.nc .
-        ln -sf ../LONG/1_O2LP_LONG_00000150_restart_${L_NPROC}.nc .
-    done
-    if [ ${USING_MPMD} == "yes" ] ; then
-       set_xio_using_server iodef.xml true
-    else
-       set_xio_using_server iodef.xml false
-    fi
-    cd ${SETTE_DIR}
-    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
-    cd ${SETTE_DIR}
-    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
-fi
-
-## Reproducibility tests for ORCA2_LIM_AGRIF
-if [ ${config} -eq 19 ] ;  then
-    export TEST_NAME="REPRO_4_4"
-    cd ${CONFIG_DIR}
-    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_agrif" del_key "key_zdftmx" del_key ${DEL_KEYS}
-    cd ${SETTE_DIR}
-    . ./param.cfg
-    . ./all_functions.sh
-    . ./prepare_exe_dir.sh
-    JOB_FILE=${EXE_DIR}/run_job.sh
-    NPROC=16
-    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
-    cd ${EXE_DIR}
-    set_namelist namelist_cfg nn_it000 1
-    set_namelist namelist_cfg nn_itend 75
-    set_namelist namelist_cfg ln_ctl .false.
-    set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg jpni 4
-    set_namelist namelist_cfg jpnj 4
-    set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2
-#
-    set_namelist 1_namelist_cfg nn_it000 1
-    set_namelist 1_namelist_cfg nn_itend 150
-    set_namelist 1_namelist_cfg ln_ctl .false.
-    set_namelist 1_namelist_cfg ln_clobber .true.
-
-    if [ ${USING_MPMD} == "yes" ] ; then
-       set_xio_using_server iodef.xml true
-    else
-       set_xio_using_server iodef.xml false
-    fi
-    cd ${SETTE_DIR}
-    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
-    cd ${SETTE_DIR}
-    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
-
-    cd ${SETTE_DIR}
-    export TEST_NAME="REPRO_2_8"
-    . ./prepare_exe_dir.sh
-    JOB_FILE=${EXE_DIR}/run_job.sh
-    NPROC=16
-    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
-    cd ${EXE_DIR}
-    set_namelist namelist_cfg nn_it000 1
-    set_namelist namelist_cfg nn_itend 75
-    set_namelist namelist_cfg ln_ctl .false.
-    set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg jpni 2
-    set_namelist namelist_cfg jpnj 8
-    set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2
-#
-    set_namelist 1_namelist_cfg nn_it000 1
-    set_namelist 1_namelist_cfg nn_itend 150
-    set_namelist 1_namelist_cfg ln_ctl .false.
-    set_namelist 1_namelist_cfg ln_clobber .true.
-
-    if [ ${USING_MPMD} == "yes" ] ; then
-       set_xio_using_server iodef.xml true
-    else
-       set_xio_using_server iodef.xml false
-    fi
-    cd ${SETTE_DIR}
-    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
-    cd ${SETTE_DIR}
-    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
-fi
-
 done
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/sette_rpt
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/sette_rpt	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/sette_rpt	(revision 10251)
@@ -440,88 +440,4 @@
   endif
 
-
-  if ( -d ./WORCA2AGUL_LONG ) then
-    set dorv = `ls -1rtd ./WORCA2AGUL_LONG/{$mach}/* | tail -1l `
-    set dorv = $dorv:t
-    set f1o = ./WORCA2AGUL_LONG/{$mach}/{$dorv}/LONG/ocean.output
-    set f1s = ./WORCA2AGUL_LONG/{$mach}/{$dorv}/LONG/solver.stat
-    set f2o = ./WORCA2AGUL_LONG/{$mach}/{$dorv}/SHORT/ocean.output
-    set f2s = ./WORCA2AGUL_LONG/{$mach}/{$dorv}/SHORT/solver.stat
-  
-    set nl = `wc -l $f2s`
-    tail -$nl[1] $f1s > f1.tmp$$
-    cmp -s f1.tmp$$ $f2s
-    if ( $status == 0 ) then
-      echo "ORCA2_LIM_AGRIF restartability  passed"
-    else
-      echo "ORCA2_LIM_AGRIF restartability  FAILED"
-      if ( $pass == 1 ) then
-        echo "<return> to view solver.stat differences"
-        set y = $<
-        sdiff f1.tmp$$ $f2s
-        echo "<return> to view ocean.output differences"
-        set y = $<
-        sdiff $f1o $f2o | grep "|"
-        echo "<return> to continue"
-        set y = $<
-      endif
-    endif
-    rm f1.tmp$$
-  endif
-
-  if ( -d ./WORCA2AGUL_16 ) then
-    set dorv = `ls -1rtd ./WORCA2AGUL_16/{$mach}/* | tail -1l `
-    set dorv = $dorv:t
-    set f1o = ./WORCA2AGUL_16/{$mach}/{$dorv}/REPRO_2_8/ocean.output
-    set f1s = ./WORCA2AGUL_16/{$mach}/{$dorv}/REPRO_2_8/solver.stat
-    set f2o = ./WORCA2AGUL_16/{$mach}/{$dorv}/REPRO_4_4/ocean.output
-    set f2s = ./WORCA2AGUL_16/{$mach}/{$dorv}/REPRO_4_4/solver.stat
-  
-    cmp -s $f1s $f2s
-    if ( $status == 0 ) then
-      echo "ORCA2_LIM_AGRIF reproducibility passed"
-    else
-      echo "ORCA2_LIM_AGRIF reproducibility FAILED"
-      if ( $pass == 1 ) then
-        echo "<return> to view solver.stat differences"
-        set y = $<
-        sdiff $f1s $f2s
-        echo "<return> to view ocean.output differences"
-        set y = $<
-        sdiff $f1o $f2o | grep "|"
-        echo "<return> to continue"
-        set y = $<
-      endif
-    endif
-  endif
-
-  if ( -d ./WORCA2AGUL_2_2_NAG ) then
-    set dorv = `ls -1rtd ./WORCA2AGUL_2_2_NAG/{$mach}/* | tail -1l `
-    set dorv = $dorv:t
-    set f1o = ./WORCA2AGUL_2_2_NAG/{$mach}/{$dorv}/SHORT_NOAGRIF/ocean.output
-    set f1s = ./WORCA2AGUL_2_2_NAG/{$mach}/{$dorv}/SHORT_NOAGRIF/solver.stat
-    set dorv = `ls -1rtd ./WORCA2AGUL_2_2/{$mach}/* | tail -1l `
-    set dorv = $dorv:t
-    set f2o = ./WORCA2AGUL_2_2/{$mach}/{$dorv}/SHORT_NOZOOM/ocean.output
-    set f2s = ./WORCA2AGUL_2_2/{$mach}/{$dorv}/SHORT_NOZOOM/solver.stat
-  
-    cmp -s $f1s $f2s
-    if ( $status == 0 ) then
-      echo "ORCA2_LIM_AGRIF code corruption test passed"
-    else
-      echo "ORCA2_LIM_AGRIF code corruption test FAILED"
-      if ( $pass == 1 ) then
-        echo "<return> to view solver.stat differences"
-        set y = $<
-        sdiff $f1s $f2s
-        echo "<return> to view ocean.output differences"
-        set y = $<
-        sdiff $f1o $f2o | grep "|"
-        echo "<return> to continue"
-        set y = $<
-      endif
-    endif
-  endif
-
   echo "<return> for second (more detailed) pass (y/n)"
   set y = $<
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/sette_rpt.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/SETTE/sette_rpt.sh	(revision 10250)
+++ 	(revision )
@@ -1,339 +1,0 @@
-#!/bin/bash -f
-#
-# simple SETTE report generator.
-#
-# This version should be run in the SETTE directory. 
-# The machine name will be picked up from the sette.sh script but the location of the
-# validation directory needs to be set here (currently assumed to reside in the ../CONFIG directory)
-#
-#########################################################################################
-######################### Start of function definitions #################################
-##
-function resttest() { 
-#
-# Restartability checks. Expects LONG and SHORT run directories
-# Compares end of LONG stat files with equivalent entries from the SHORT stat files.
-#
-  vdir=$1
-  nam=$2
-  pass=$3
-  mach=$4
-#
-  if [ -d $vdir/$nam ]; then
-    dorv=`ls -1rt $vdir/$nam/$mach/ | tail -1l `
-    dorv=`echo $dorv | sed -e 's:.*/::'`
-    f1o=$vdir/$nam/$mach/$dorv/LONG/ocean.output
-    f1s=$vdir/$nam/$mach/$dorv/LONG/solver.stat
-    f1t=$vdir/$nam/$mach/$dorv/LONG/tracer.stat
-    f2o=$vdir/$nam/$mach/$dorv/SHORT/ocean.output
-    f2s=$vdir/$nam/$mach/$dorv/SHORT/solver.stat
-    f2t=$vdir/$nam/$mach/$dorv/SHORT/tracer.stat
-
-    if  [ ! -f $f1s ] &&  [ ! -f $f1t ] ; then 
-      printf "%-20s %s\n" $nam " incomplete test";
-      return; 
-    fi
-    if  [ ! -f $f2s ] &&  [ ! -f $f2t ] ; then 
-      printf "%-20s %s\n" $nam " incomplete test";
-      return; 
-    fi
-#
-    done_oce=0
-
-    if  [  -f $f1s ] && [  -f $f2s ]; then 
-      nl=(`wc -l $f2s`)
-      tail -${nl[0]} $f1s > f1.tmp$$
-      cmp -s f1.tmp$$ $f2s
-      if [ $? == 0 ]; then
-        if [ $pass == 0 ]; then 
-          printf "%-20s %s %s\n" $nam  " solver.stat restartability  passed : " $dorv
-        fi
-      else
-        printf "%-20s %s %s\n" $nam  " solver.stat restartability  FAILED : " $dorv 
-#
-# Offer view of differences on the second pass
-#
-        if [ $pass == 1 ]; then
-          echo "<return> to view solver.stat differences"
-          read y
-          sdiff f1.tmp$$ $f2s
-          echo "<return> to view ocean.output differences"
-          read y
-          sdiff $f1o $f2o | grep "|"
-          done_oce=1
-          echo "<return> to continue"
-          read y
-        fi
-      fi
-    fi
-#
-# Check tracer.stat files (if they exist)
-#
-    if  [  -f $f1t ] && [  -f $f2t ]; then
-      nl=(`wc -l $f2t`)
-      tail -${nl[0]} $f1t > f1.tmp$$
-      cmp -s f1.tmp$$ $f2t
-      if [ $? == 0 ]; then
-        if [ $pass == 0 ]; then 
-          printf "%-20s %s %s\n" $nam  " tracer.stat restartability  passed : " $dorv
-        fi
-      else
-        printf "%-20s %s %s\n" $nam  " tracer.stat restartability  FAILED : " $dorv 
-#
-# Offer view of differences on the second pass
-#
-        if [ $pass == 1 ]; then
-          echo "<return> to view tracer.stat differences"
-          read y
-          sdiff f1.tmp$$ $f2t
-#
-# Only offer ocean.output view if it has not been viewed previously
-#
-          if [ $done_oce == 0 ]; then
-            echo "<return> to view ocean.output differences"
-            read y
-            sdiff $f1o $f2o | grep "|"
-          fi
-          echo "<return> to continue"
-          read y
-        fi
-      fi
-    fi
-    rm f1.tmp$$
-  fi
-}
-
-function reprotest(){
-#
-# Reproducibility checks. Expects REPRO_N_M and REPRO_I_J run directories
-# Compares end of stat files from each
-#
-  vdir=$1
-  nam=$2
-  pass=$3
-  mach=$4
-#
-  if [ -d $vdir/$nam ]; then
-    dorv=`ls -1rt $vdir/$nam/$mach/ | tail -1l `
-    dorv=`echo $dorv | sed -e 's:.*/::'`
-    rep1=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -2l | head -1 `
-    rep2=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -1l`
-    f1o=$vdir/$nam/$mach/$dorv/$rep1/ocean.output
-    f1s=$vdir/$nam/$mach/$dorv/$rep1/solver.stat
-    f1t=$vdir/$nam/$mach/$dorv/$rep1/tracer.stat
-    f2o=$vdir/$nam/$mach/$dorv/$rep2/ocean.output
-    f2s=$vdir/$nam/$mach/$dorv/$rep2/solver.stat
-    f2t=$vdir/$nam/$mach/$dorv/$rep2/tracer.stat
-
-    if  [ ! -f $f1s ] && [ ! -f $f1t ] ; then 
-      printf "%-20s %s\n" $nam " incomplete test";
-      return; 
-    fi
-    if  [ ! -f $f2s ] && [ ! -f $f2t ] ; then 
-      printf "%-20s %s\n" $nam " incomplete test";
-      return; 
-    fi
-#
-    done_oce=0
-
-    if  [ -f $f1s ] && [ -f $f2s ] ; then
-      cmp -s $f1s $f2s
-      if [ $? == 0 ]; then
-        if [ $pass == 0 ]; then 
-          printf "%-20s %s %s\n" $nam  " solver.stat reproducibility passed : " $dorv
-        fi
-      else
-        printf "%-20s %s %s\n" $nam  " solver.stat reproducibility FAILED : " $dorv 
-#
-# Offer view of differences on the second pass
-#
-        if [ $pass == 1 ]; then
-          echo "<return> to view solver.stat differences"
-          read y
-          sdiff f1.tmp$$ $f2s
-          echo "<return> to view ocean.output differences"
-          read y
-          sdiff $f1o $f2o | grep "|"
-          done_oce=1
-          echo "<return> to continue"
-          read y
-        fi
-      fi
-    fi
-#
-# Check tracer.stat files (if they exist)
-#
-    if  [ -f $f1t ] && [ -f $f2t ] ; then
-      cmp -s $f1t $f2t
-      if [ $? == 0 ]; then
-        if [ $pass == 0 ]; then           printf "%-20s %s %s\n" $nam  " tracer.stat reproducibility passed : " $dorv
-        fi
-      else
-        printf "%-20s %s %s\n" $nam  " tracer.stat reproducibility  FAILED : " $dorv
-#
-# Offer view of differences on the second pass
-#
-        if [ $pass == 1 ]; then
-          echo "<return> to view tracer.stat differences"
-          read y
-          sdiff $f1t $f2t
-#
-# Only offer ocean.output view if it has not been viewed previously
-#
-          if [ $done_oce == 0 ]; then
-            echo "<return> to view ocean.output differences"
-            read y
-            sdiff $f1o $f2o | grep "|"
-          fi
-          echo "<return> to continue"
-          read y
-        fi
-      fi
-    fi
-  fi
-}
-
-function xiostest() { 
-#
-# XIOS functionality checks. Expects ATTACHED_MULTIPLE, ATTACHED_ONE, DETACHED_MULTIPLE and
-# DETACHED_ONE run directories.
-# Compares stat files from ATTACHED_MULTIPLE with equivalent entries from the others
-#
-  vdir=$1
-  nam=$2
-  pass=$3
-  mach=$4
-#
-  if [ -d $vdir/$nam ]; then
-    dorv=`ls -1rt $vdir/$nam/$mach/ | tail -1l `
-    dorv=`echo $dorv | sed -e 's:.*/::'`
-    f1o=$vdir/$nam/$mach/$dorv/ATTACHED_MULTIPLE/ocean.output
-    f1s=$vdir/$nam/$mach/$dorv/ATTACHED_MULTIPLE/solver.stat
-    f1t=$vdir/$nam/$mach/$dorv/ATTACHED_MULTIPLE/tracer.stat
-    if [ $pass == 0 ]; then printf "%-20s %s %s\n" $nam " checking against " "ATTACHED_MULTIPLE" ; fi
-    for OTHER in ATTACHED_ONE DETACHED_MULTIPLE DETACHED_ONE
-    do
-      f2o=$vdir/$nam/$mach/$dorv/$OTHER/ocean.output
-      f2s=$vdir/$nam/$mach/$dorv/$OTHER/solver.stat
-      f2t=$vdir/$nam/$mach/$dorv/$OTHER/tracer.stat
-
-      if  [ ! -f $f1s ] &&  [ ! -f $f1t ] ; then 
-        printf "%-20s %s %s\n" $nam " incomplete test " $OTHER;
-        return; 
-      fi
-      if  [ ! -f $f2s ] &&  [ ! -f $f2t ] ; then 
-        printf "%-20s %s %s\n" $nam " incomplete test " $OTHER;
-        return; 
-      fi
-#
-      done_oce=0
-
-      if  [  -f $f1s ] && [  -f $f2s ]; then 
-        nl=(`wc -l $f2s`)
-        tail -${nl[0]} $f1s > f1.tmp$$
-        cmp -s f1.tmp$$ $f2s
-        if [ $? == 0 ]; then
-          if [ $pass == 0 ]; then 
-            printf "%-20s %s %s %s\n" $nam  " solver.stat restartability  passed : " $dorv $OTHER
-          fi
-        else
-          printf "%-20s %s %s %s\n" $nam  " solver.stat restartability  FAILED : " $dorv  $OTHER
-#
-# Offer view of differences on the second pass
-#
-          if [ $pass == 1 ]; then
-            echo "<return> to view solver.stat differences"
-            read y
-            sdiff f1.tmp$$ $f2s
-            echo "<return> to view ocean.output differences"
-            read y
-            sdiff $f1o $f2o | grep "|"
-            done_oce=1
-            echo "<return> to continue"
-            read y
-          fi
-        fi
-      fi
-#
-# Check tracer.stat files (if they exist)
-#
-      if  [  -f $f1t ] && [  -f $f2t ]; then
-        nl=(`wc -l $f2t`)
-        tail -${nl[0]} $f1t > f1.tmp$$
-        cmp -s f1.tmp$$ $f2t
-        if [ $? == 0 ]; then
-          if [ $pass == 0 ]; then 
-            printf "%-20s %s %s %s\n" $nam  " tracer.stat restartability  passed : " $dorv $OTHER
-          fi
-        else
-          printf "%-20s %s %s %s\n" $nam  " tracer.stat restartability  FAILED : " $dorv  $OTHER
-#
-# Offer view of differences on the second pass
-#
-          if [ $pass == 1 ]; then
-            echo "<return> to view tracer.stat differences"
-            read y
-            sdiff f1.tmp$$ $f2t
-#
-# Only offer ocean.output view if it has not been viewed previously
-#
-            if [ $done_oce == 0 ]; then
-              echo "<return> to view ocean.output differences"
-              read y
-              sdiff $f1o $f2o | grep "|"
-            fi
-            echo "<return> to continue"
-            read y
-          fi
-        fi
-      fi
-      rm f1.tmp$$
-    done
-  fi
-}
-
-########################### END of function definitions #################################
-##                                                                                     ##
-##    Main script                                                                      ##
-##                                                                                     ##
-#########################################################################################
-#
-  mach1=`grep "COMPILER=" ./sette.sh | sed -e 's/COMPILER=//'`
-  mach2=`grep "COMPILER=" ./sette_xios.sh | sed -e 's/COMPILER=//'`
-  NEMO_VALID=`grep "NEMO_VALIDATION_DIR=" ./param.cfg | sed -e 's/NEMO_VALIDATION_DIR=//'`
-#
-  if [ ! -d $NEMO_VALID ]; then
-    echo "$NEMO_VALID validation directory not found"
-    exit
-  fi
-#
-# The script also needs the date or revision tag. Currently this is taken from the latest sub-directory found in each directory
-#  
-for pass in  0 1 
-do
-#
- if [ $pass == 1 ]; then echo "---------------2nd pass------------------";fi
-#
-# Restartability test
-#
- for restart_test in WGYRE_LONG WISOMIP_LONG WORCA2LIMPIS_LONG WORCA2OFFPIS_LONG WAMM12_LONG WORCA2LIM3_LONG WSAS_LONG WORCA2AGUL_LONG
- do
-   resttest $NEMO_VALID $restart_test $pass $mach1
- done
-#
-# sette_xios tests (allow for the possibility of a different compiler base)
-#
- for xios_test in WGYRE_XIOS_LR WGYRE_XIOS_HR
- do
-   xiostest $NEMO_VALID $xios_test $pass $mach2
- done
-#
-# Reproducibility tests
-#
- for repro_test in WGYRE_4 WISOMIP_4 WORCA2LIMPIS_16 WORCA2OFFPIS_16 WAMM12_32 WORCA2LIM3_16 WORCA2_LIM_OBS WSAS_32 WORCA2AGUL_1_2 WORCA2AGUL_16 WORCA2AGUL_2_2_NAG
- do
-   reprotest $NEMO_VALID $repro_test $pass $mach1
- done
-#
-done
-exit
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 10251)
@@ -50,5 +50,5 @@
 # ==========
 #
-# $Id$
+# $Id: Fmake_config.sh 3715 2012-11-28 16:06:02Z acc $
 #
 #
@@ -65,5 +65,4 @@
 [ -f ${2}/EXP00/iodef.xml ] &&  \cp -R  ${2}/EXP00/iodef.xml ${1}/EXP00/.
 [ -f ${2}/EXP00/field_def.xml ] &&  \cp -R  ${2}/EXP00/field_def.xml ${1}/EXP00/.
-[ -f ${2}/EXP00/file_def.xml ] &&  \cp -R  ${2}/EXP00/file_def.xml ${1}/EXP00/.
 [ -f ${2}/EXP00/domain_def.xml ] &&  \cp -R  ${2}/EXP00/domain_def.xml ${1}/EXP00/.
 [ -f ${2}/EXP00/xmlio_server.def ] &&  \cp -R  ${2}/EXP00/xmlio_server.def ${1}/EXP00/.
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 10251)
@@ -47,5 +47,5 @@
 # ==========
 #
-# $Id$
+# $Id: Fprep_agrif.sh 3294 2012-01-28 16:44:18Z rblod $
 #
 #
@@ -57,15 +57,8 @@
 #- AGRIF conv
 if [ "$AGRIFUSE" == 1 ]; then
-#-MPI for AGRIF
-if [ ! -f ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h ];then
-   echo '#if defined key_mpp_mpi' > ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
-   echo '#define AGRIF_MPI'      >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
-   echo '#endif'                 >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
-fi
 
 #- CONV
-fcm build ${COMPIL_DIR}/conv.cfg || exit 1
-#C_COMPILER=${CC-cc}
-#gmake CC=${C_COMPILER} -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB
+#fcm build ${TOOLS_DIR}/conv.cfg || exit 1
+gmake -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB
 
 #- AGRIF sources
@@ -74,6 +67,5 @@
 [ ! -d $2/$1/OPAFILES/AGRIF_MODELFILES ] && mkdir  $2/$1/OPAFILES/AGRIF_MODELFILES
 cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/agrif_opa.in  $2/$1/OPAFILES/
-#cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv  $2/$1/OPAFILES/
-cp -f -r $2/$1/AGRIFLIB/bin/conv  $2/$1/OPAFILES/
+cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv  $2/$1/OPAFILES/
 
 fi
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/agrifpp.sh
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 10251)
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/bld.cfg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 10251)
@@ -41,5 +41,5 @@
 bld::tool::fppflags::nemo      %FPPFLAGS -I$CONFIG_DIR/$NEW_CONF/OPAFILES/inc
 bld::tool::fppflags::ioipsl    %FPPFLAGS
-bld::tool::fppflags::agrif     %FPPFLAGS -include ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
+bld::tool::fppflags::agrif     %FPPFLAGS
 
 # Ignore the following dependencies
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 10251)
@@ -52,5 +52,4 @@
 bld::excl_dep	     use::ioipsl
 bld::excl_dep	     use::xios
-bld::excl_dep        use::agrif_grids
 bld::excl_dep	     use::agrif_types
 bld::excl_dep	     use::agrif_util
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/conv.cfg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 10251)
@@ -8,8 +8,6 @@
 # Build information
 # ------------------------------------------------------------------------------
-inc $COMPIL_DIR/arch_nemo.fcm
+inc $COMPIL_DIR/arch.fcm
 
-bld::tool::cc        %CC
-bld::tool::cflags    %CFLAGS
 bld::tool::make      %MK
 
@@ -21,8 +19,8 @@
 dir::root            $NEMO_TDIR/$NEW_CONF/AGRIFLIB
 
-#bld::tool::cflags::convsrc  -O0  
-#bld::tool::ld::convsrc   cc
-#bld::tool::ldflags::convsrc -O  ../obj/fortran.o ../obj/fortran.o 
-#bld::pp 1
+bld::tool::cflags::convsrc  -O0  
+bld::tool::ld::convsrc   cc
+bld::tool::ldflags::convsrc -O  ../obj/fortran.o ../obj/fortran.o 
+bld::pp 1
 
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/tools.txt
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 10251)
@@ -1,1 +1,1 @@
-SIREN 
+REBUILD 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/agulhas
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/agulhas	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/agulhas	(revision 10251)
@@ -17,5 +17,4 @@
     removeclosedseas = true
     type_bathy_interp = 0 
-    rn_hmin = -3 
 /   
 
@@ -40,8 +39,4 @@
     pa1  = 245.58132232490
     N  = 31
-    ldbletanh   = .FALSE.
-    ppa2        = 0.0
-    ppkth2      = 0.0
-    ppacr2      = 0.0
 /    
     
@@ -50,6 +45,6 @@
     parent_bathy_meter = 'bathy_meter.nc'
     parent_batmet_name = 'Bathymetry'
-    e3zps_min = 20.
-    e3zps_rat = 0.1
+    e3zps_min = 25.
+    e3zps_rat = 0.2
 /
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 10251)
@@ -105,5 +105,5 @@
     IMPLICIT NONE
     !
-    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
     TYPE(Coordinates) :: Grid
     INTEGER :: i,j
@@ -134,5 +134,4 @@
        za0  = pa0
        za1  = pa1
-       za2  = pa2
        !
     ELSE
@@ -148,49 +147,19 @@
 
     zacr = ppacr
-    zkth = ppkth
-    zacr2 = ppacr2
-    zkth2 = ppkth2   
+    zkth = ppkth 
+
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
-       za1 = pphmax / FLOAT(N-1) 
-       DO i = 1, N
-          gdepw(i) = ( i - 1   ) * za1
-          gdept(i) = ( i - 0.5 ) * za1
-          e3w  (i) =  za1
-          e3t  (i) =  za1
-       END DO
-    ELSE                            ! Madec & Imbard 1996 function
-       IF( .NOT. ldbletanh ) THEN
-          DO i = 1,N
-             ! 
-             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
-             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
-             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-             !
-          END DO
-       ELSE
-          DO i = 1,N
-             ! Double tanh function
-             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
-                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
-             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
-                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
-             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
-                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
-             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
-                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
-            END DO
-       ENDIF
-    ENDIF
+    DO i = 1,N
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+    END DO
     !
     gdepw(1) = 0.0
     zmax = gdepw(N) + e3t(N)
-    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
-    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
-    ENDIF
-    zmin = gdepw(i+1)
+    zmin = gdepw(4)
     !
     IF ( .NOT. ASSOCIATED(Grid%bathy_level)) &
@@ -258,5 +227,5 @@
     IMPLICIT NONE
     !
-    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
     TYPE(Coordinates) :: Grid
     INTEGER :: i,j
@@ -288,5 +257,4 @@
        za0  = pa0
        za1  = pa1
-       za2  = pa2
        !
     ELSE
@@ -296,48 +264,22 @@
        WRITE(*,*) 'please check values of variables'
        WRITE(*,*) 'in namelist vertical_grid section'
-       WRITE(*,*) ' ' 
-       STOP     
+       WRITE(*,*) ' '
+       STOP      
        !       
     ENDIF
-
+    !
     zacr = ppacr
-    zkth = ppkth
-    zacr2 = ppacr2
-    zkth2 = ppkth2   
+    zkth = ppkth 
+
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
-       za1 = pphmax / FLOAT(N-1) 
-       DO i = 1, N
-          gdepw(i) = ( i - 1   ) * za1
-          gdept(i) = ( i - 0.5 ) * za1
-          e3w  (i) =  za1
-          e3t  (i) =  za1
-       END DO
-    ELSE                            ! Madec & Imbard 1996 function
-       IF( .NOT. ldbletanh ) THEN
-          DO i = 1,N
-             ! 
-             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
-             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
-             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-             !
-          END DO
-       ELSE
-          DO i = 1,N
-             ! Double tanh function
-             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
-                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
-             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
-                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
-             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
-                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
-             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
-                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
-         END DO
-       ENDIF
-    ENDIF
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+    END DO
     !
     gdepw(1) = 0.0  
@@ -742,8 +684,8 @@
   ! for consistency with fine grid bathymetry			*
   !								*
-  ! if a given coarse grid point is masked and one of the	  *
-  ! child grid points contained in this coarse cell is not masked *
-  ! the corresponding coarse grid point is unmasked with rn_hmin  *
-  ! value						          *
+  ! if a given coarse grid point is masked and one of the		*
+  ! child grid points contained in this coarse cell is not masked	*
+  ! the corresponding coarse grid point is unmasked with gdepw(4) *
+  ! value								*
   !								*
   ! - input :							*
@@ -762,5 +704,5 @@
     !
     INTEGER :: ideb,jdeb,ifin,jfin
-    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin
     INTEGER :: i,j
     INTEGER :: k1
@@ -785,5 +727,4 @@
        za0  = pa0
        za1  = pa1
-       za2  = pa2
        !
     ELSE
@@ -799,47 +740,18 @@
 
     zacr = ppacr
-    zkth = ppkth
-    zacr2 = ppacr2
-    zkth2 = ppkth2   
+    zkth = ppkth 
+
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
-       za1 = pphmax / FLOAT(N-1) 
-       DO i = 1, N
-          gdepw(i) = ( i - 1   ) * za1
-          gdept(i) = ( i - 0.5 ) * za1
-          e3w  (i) =  za1
-          e3t  (i) =  za1
-       END DO
-    ELSE                            ! Madec & Imbard 1996 function
-       IF( .NOT. ldbletanh ) THEN
-          DO i = 1,N
-             ! 
-             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
-             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
-             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-             !
-          END DO
-       ELSE
-          DO i = 1,N
-             ! Double tanh function
-             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
-                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
-             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
-                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
-             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
-                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
-             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
-                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
-          END DO
-       ENDIF
-    ENDIF
-    !
-    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
-    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
-    ENDIF
-    zmin = gdepw(i+1)
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+    END DO
+    !
+    zmin = gdepw(4)
     !      
     diff = 0
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 10251)
@@ -36,5 +36,5 @@
     !       
     TYPE(Coordinates) :: Grid                     
-    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
     INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt
     INTEGER, DIMENSION(1) :: k
@@ -76,5 +76,4 @@
        za0  = pa0
        za1  = pa1
-       za2  = pa2
        !
     ELSE
@@ -89,41 +88,17 @@
     ENDIF
 
-    zacr  = ppacr
-    zkth  = ppkth     
-    zacr2 = ppacr2
-    zkth2 = ppkth2  
-    !
-    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
-         za1 = pphmax / FLOAT(N-1) 
-         DO i = 1, N
-            gdepw(i) = ( i - 1   ) * za1
-            gdept(i) = ( i - 0.5 ) * za1
-            e3w  (i) =  za1
-            e3t  (i) =  za1
-         END DO
-    ELSE                            ! Madec & Imbard 1996 function
-       IF( .NOT. ldbletanh ) THEN
-          DO i = 1,N
-             ! 
-             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
-             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
-             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-             !
-          END DO
-       ELSE
-            DO i = 1,N
-               ! Double tanh function
-               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
-                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
-               gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
-                  &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
-               e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
-                  &                            + za2        * TANH(       (i-zkth2) / zacr2 )
-               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
-                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
-            END DO
-       ENDIF
-    ENDIF
+    zacr = ppacr
+    zkth = ppkth       
+    !
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+       !
+    END DO
+    !
+
     gdepw(1) = 0.0  
     !
@@ -131,8 +106,5 @@
     !
     zmax = gdepw(N) + e3t(N)
-    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
-    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
-    ENDIF
-    zmin = gdepw(i+1)
+    zmin = gdepw(4)
     !
     ! Initialize bathy_level to the maximum ocean level available
@@ -263,12 +235,11 @@
     INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt
     REAL,DIMENSION(N) :: gdepw,e3t
-    REAL :: za0,za1,za2,zsur,zacr,zacr2,zkth,zkth2,zmin,zmax,zdepth
+    REAL :: za0,za1,zsur,zacr,zkth,zmin,zmax,zdepth
     INTEGER :: kbathy,jk,diff
     INTEGER :: bornex,borney,bornex2,borney2
-    !
+    !       
     IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
          .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
        !    
-       WRITE(*,*) 'psur,pa0,pa1 computed'
        za1=( ppdzmin - pphmax / (N-1) )          &
             / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
@@ -282,9 +253,7 @@
          pa0.NE.0 .AND. pa1.NE.0 ) THEN
        !       
-       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
        zsur = psur
        za0  = pa0
        za1  = pa1
-       za2  = pa2
        !
     ELSE
@@ -294,39 +263,19 @@
        WRITE(*,*) 'please check values of variables'
        WRITE(*,*) 'in namelist vertical_grid section'
-       WRITE(*,*) ' '  
-       STOP    
+       WRITE(*,*) ' '      
        !       
     ENDIF
-
-    zacr  = ppacr
-    zkth  = ppkth     
-    zacr2 = ppacr2
-    zkth2 = ppkth2  
-    !
-    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
-         za1 = pphmax / FLOAT(N-1) 
-         DO i = 1, N
-            gdepw(i) = ( i - 1   ) * za1
-            e3t  (i) =  za1
-         END DO
-    ELSE                            ! Madec & Imbard 1996 function
-       IF( .NOT. ldbletanh ) THEN
-          DO i = 1,N
-             ! 
-             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-             !
-          END DO
-       ELSE
-            DO i = 1,N
-               ! Double tanh function
-               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
-                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
-               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
-                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
-            END DO
-       ENDIF
-    ENDIF
+    !       
+    zacr = ppacr
+    zkth = ppkth       
+    !
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))       
+    END DO
+    !
     gdepw(1) = 0.0
+    !
     !
     diff = 0      
@@ -395,8 +344,5 @@
     !
     zmax = gdepw(N) + e3t(N)
-    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
-    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
-    ENDIF
-    zmin = gdepw(i+1)
+    zmin = gdepw(4) 
     !
     ! check that interpolated value stays at the same level         
@@ -700,5 +646,5 @@
     REAL*8, DIMENSION(:,:,:) :: fse3u,fse3t,fse3v
     !                                  
-    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
     INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk
     INTEGER, DIMENSION(1) :: k
@@ -714,5 +660,5 @@
     ALLOCATE(gdepw(jpk),e3t(jpk))
     ALLOCATE(gdepw_ps(jpi,jpj,jpk))                  
-    !  
+    !       
     IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
          .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
@@ -722,6 +668,6 @@
             / ( TANH((1-ppkth)/ppacr) - ppacr/(jpk-1) &
             *  (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
-            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
-
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
+       !
        za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
        zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
@@ -730,53 +676,18 @@
          pa0.NE.0 .AND. pa1.NE.0 ) THEN
        !       
-       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
        zsur = psur
        za0  = pa0
-       za1  = pa1
-       za2  = pa2
-       !
-    ELSE
-       !       
-       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
-       WRITE(*,*) ' '
-       WRITE(*,*) 'please check values of variables'
-       WRITE(*,*) 'in namelist vertical_grid section'
-       WRITE(*,*) ' '  
-       STOP    
+       za1  = pa1   
        !       
     ENDIF
 
-    zacr  = ppacr
-    zkth  = ppkth     
-    zacr2 = ppacr2
-    zkth2 = ppkth2  
-    !
-    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
-         za1 = pphmax / FLOAT(jpk-1) 
-         DO i = 1, jpk
-            gdepw(i) = ( i - 1   ) * za1
-            e3t  (i) =  za1
-         END DO
-    ELSE                            ! Madec & Imbard 1996 function
-       IF( .NOT. ldbletanh ) THEN
-          DO i = 1,jpk
-             ! 
-             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-             !
-          END DO
-       ELSE
-            DO i = 1,jpk
-               ! Double tanh function
-               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
-                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
-               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
-                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
-            END DO
-       ENDIF
-    ENDIF         
+    zacr = ppacr
+    zkth = ppkth       
     !         
     !                
     DO i = 1,jpk
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
        !       
        fse3t(:,:,i) = e3t(i)
@@ -789,8 +700,5 @@
     !
     zmax = gdepw(jpk) + e3t(jpk)
-    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
-    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
-    ENDIF
-    zmin = gdepw(i+1)
+    zmin = gdepw(4)
     !
     DO jj = 1, jpj
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 10251)
@@ -51,9 +51,7 @@
   INTEGER jpizoom,jpjzoom,nb_connection_pts
   !      
-  REAL*8 rn_hmin
-  REAL*8 ppkth2, ppacr2, ppkth,ppacr,ppdzmin,pphmax,smoothing_factor,e3zps_min,e3zps_rat
-  REAL*8 psur,pa0,pa1,pa2,adatrj
+  REAL*8 ppacr,ppdzmin,pphmax,ppkth,smoothing_factor,e3zps_min,e3zps_rat
+  REAL*8 psur,pa0,pa1,adatrj
   !       
-  LOGICAL ldbletanh
   LOGICAL partial_steps,smoothing,bathy_update
   LOGICAL new_topo,removeclosedseas,dimg,iom_activated
@@ -72,9 +70,9 @@
   !      
   NAMELIST /bathymetry/new_topo,elevation_database,elevation_name,smoothing,smoothing_factor, &
-       nb_connection_pts,removeclosedseas,type_bathy_interp,rn_hmin      
+       nb_connection_pts,removeclosedseas,type_bathy_interp      
   !      
   NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file      
   !
-  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,ppa2,ppkth2,ppacr2
+  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N
   ! 
   NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat      
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 10251)
@@ -1,159 +1,73 @@
-# name       | units          | axis | pt| interpolation   | long name                             | standard name                                  
-X            | 1              | X    |   |                 |                                       | projection_x_coordinate               
-Y            | 1              | Y    |   |                 |                                       | projection_y_coordinate               
-Z            | 1              | Z    |   |                 |                                       | projection_z_coordinate               
-T            | 1              | T    |   |                 |                                       | projection_t_coordinate               
-nav_lon      | degrees_east   | XY   | T | cubic           | Longitude                             | longitude                                   
-nav_lat      | degrees_north  | XY   | T | cubic           | Latitude                              | latitude                         
-nav_lev      | model_levels   | Z    | T | cubic           | Model levels                          |                                  
-deptht       | m              | Z    | T |                 | Vertical T levels                     | depth                            
-time_counter |                | T    |   |                 | Time axis                             | time                             
-Bathymetry   | m              | XY   | T | cubic           | Bathymetry                            | bathymetry                       
-votemper     | degree_Celsius | XYZT | T | cubic           | Temperature                           | sea_water_potential_temperature  
-vozocrtx     | m s-1          | XYZT | U | cubic           | Zonal velocity                        |                                  
-vomecrty     | m s-1          | XYZT | V | cubic           | Meridional velocity                   |                                  
-vosaline     | PSU            | XYZT | T | cubic           | Salinity                              | sea_water_salinity               
-sossheig     | m              | XYT  | T | cubic           | Sea Surface Height                    | sea_surface_height               
-sotemper     | m              | XYT  | T | cubic           |                                       |                                  
-sossheig     | m              | XYT  | T | cubic           |                                       |                                  
-glamt        | degrees_east   | XY   | T | cubic           | Longitude_T                           |                                  
-glamu        | degrees_east   | XY   | U | cubic           | Longitude_U                           |                                   
-glamv        | degrees_east   | XY   | V | cubic           | Longitude_V                           |                                  
-glamf        | degrees_east   | XY   | F | cubic           | Longitude_F                           |                                  
-gphit        | degrees_north  | XY   | T | cubic           | Latitude_T                            |                                  
-gphiu        | degrees_north  | XY   | U | cubic           | Latitude_U                            |                                  
-gphiv        | degrees_north  | XY   | V | cubic           | Latitude_V                            |                                  
-gphif        | degrees_north  | XY   | F | cubic           | Latitude_F                            |                                  
-e1t          | m              | XY   | T | cubic/rhoi      |                                       |                                  
-e1u          | m              | XY   | U | cubic/rhoi      |                                       |                                  
-e1v          | m              | XY   | V | cubic/rhoi      |                                       |                                  
-e1f          | m              | XY   | F | cubic/rhoi      |                                       |                                  
-e2t          | m              | XY   | T | cubic/rhoj      |                                       |                                  
-e2u          | m              | XY   | U | cubic/rhoj      |                                       |                                  
-e2v          | m              | XY   | V | cubic/rhoj      |                                       |                                  
-e2f          | m              | XY   | F | cubic/rhoj      |                                       |                                  
-tmask        |                | XYZ  | T | nearest         |                                       |                                  
-umask        |                | XYZ  | U | nearest         |                                       |                                  
-vmask        |                | XYZ  | V | nearest         |                                       |                                  
-fmask        |                | XYZ  | F | nearest         |                                       |                                  
-weight       |                | XY   | T |                 |                                       |                                  
-kt           |                |      |   |                 |                                       |                                  
-ndastp       |                |      |   |                 |                                       |                                  
-adatrj       |                |      |   |                 |                                       |                                  
-kt           |                |      |   |                 |                                       |                                  
-rdt          |                |      |   |                 |                                       |                                  
-rdttra1      |                |      |   |                 |                                       |                                  
-utau_b       |                | XY   | U |                 |                                       |surface_downward_eastward_stress  
-vtau_b       |                | XY   | V |                 |                                       |surface_downward_northward_stress 
-qns_b        |                | XY   | T |                 |                                       |                                  
-emp_b        |                | XY   | T |                 |                                       |                                  
-sfx_b        |                | XY   | T |                 |                                       |                                  
-en           |                | XYZ  | T |                 |                                       |                                  
-avt          |                | XYZ  | T |                 | vertical eddy diffusivity             |                                  
-avm          |                | XYZ  | T |                 | vertical eddy viscosity               |                                  
-avmu         |                | XYZ  | T |                 |                                       |                                  
-avmv         |                | XYZ  | T |                 |                                       |                                  
-dissl        |                | XYZ  | T |                 |                                       |                                  
-sbc_hc_b     |                | XY   | T |                 |                                       |                                  
-sbc_sc_b     |                | XY   | T |                 |                                       |                                  
-gcx          |                | XY   | T |                 |                                       |                                  
-gcxb         |                | XY   | T |                 |                                       |                                  
-ub           |                | XYZ  | U |                 |                                       |                                  
-vb           |                | XYZ  | V |                 |                                       |                                  
-tb           |                | XYZ  | T |                 |                                       |                                  
-sb           |                | XYZ  | T |                 |                                       |                                  
-rotb         |                | XYZ  | T |                 |                                       |                                  
-hdivb        |                | XYZ  | T |                 |                                       |                                  
-sshb         |                | XY   | T |                 |                                       |                                  
-un           |                | XYZ  | U |                 |                                       |                                  
-vn           |                | XYZ  | V |                 |                                       |                                  
-tn           |                | XYZ  | T |                 |                                       |                                  
-sn           |                | XYZ  | T |                 |                                       |                                  
-rotn         |                | XYZ  | T |                 |                                       |                                  
-hdivn        |                | XYZ  | T |                 |                                       |                                  
-sshn         |                | XYT  | T |                 |                                       |                                  
-rhop         |                | XYZ  | T |                 |                                       |                                  
-dic          |                | XYZT | T |                 | Dissolved Inorganic Carbon            | mole_concentration_of_dissolved_inorganic_caron_in_sea_water
-alkalini     |                | XYZT | T |                 | Total Alkalinity                      | sea_water_alkalinity_expressed_as_mole_equivalent
-o2           |                | XYZT | T |                 | Dissolved Oxygen                      | mole_concentration_of_dissolved_molecular_oxygen_in_sea_water
-caco3        |                | XYZT | T |                 | Calcite                               |                                  
-po4          |                | XYZT | T |                 | Phosphate                             | mole_concentration_of_phosphate_in_sea_water
-poc          |                | XYZT | T |                 | Small Particulate Organic Carbon      |                                  
-si           |                | XYZT | T |                 | Dissolved Silicate                    | mole_concentration_of_silicate_in_sea_water
-phy          |                | XYZT | T |                 | Nanophytoplankton                     |                                  
-zoo          |                | XYZT | T |                 | Microzooplankton                      | mole_concentration_of_microzooplankton_expressed_as_carbon_in_sea_water
-doc          |                | XYZT | T |                 | Dissolved Organic Carbon              |                                  
-phy2         |                | XYZT | T |                 | Diatoms                               |                                  
-zoo2         |                | XYZT | T |                 | Mesozooplankton                       | mole_concentration_of_mesozooplankton_expressed_as_carbon_in_sea_water
-gsi          |                | XYZT | T |                 | Sinking biogenic Silica               |                                  
-fer          |                | XYZT | T |                 | Dissolved Iron                        | mole_concentration_of_dissolved_iron_in_sea_water
-bfe          |                | XYZT | T |                 | Iron in the big particles             |                                  
-goc          |                | XYZT | T |                 | Big Particulate Organic Carbon        |                                  
-sfe          |                | XYZT | T |                 | Iron in the small particles           |                                  
-dfe          |                | XYZT | T |                 | Iron content of the Diatoms           |                                  
-dsi          |                | XYZT | T |                 | Silicon content of the Diatoms        |                                  
-nfe          |                | XYZT | T |                 | Iron content of the Nanophytoplankton |                                  
-nchl         |                | XYZT | T |                 | Chlorophyll of the Nanophytoplankton  |                                  
-dchl         |                | XYZT | T |                 | Chlorophyll of the Diatoms            |                                  
-no3          |                | XYZT | T |                 | Nitrate                               | mole_concentration_of_nitrate_in_sea_water
-nh4          |                | XYZT | T |                 | Ammonium                              | mole_concentration_of_ammonium_in_sea_water
-ppd          |                | XYZT | T |                 |                                       |                                  
-ppn          |                | XYZT | T |                 |                                       |                                  
-ph           |                | XYZT | T |                 |                                       |                                  
-cflx         |                | XYZT | T |                 |                                       |                                  
-oflx         |                | XYZT | T |                 |                                       |                                  
-kg           |                | XYZT | T |                 |                                       |                                  
-dpco2        |                | XYZT | T |                 |                                       |                                  
-heup         |                | XYZT | T |                 |                                       |                                  
-kz           |                | XYZT | T |                 |                                       |                                  
-irondep      |                | XYZT | T |                 |                                       |                                  
-kt_ice       |                |      |   |                 |                                       |                                  
-hicif        |                |      |   |                 |                                       |                                  
-hsnif        |                |      |   |                 |                                       |                                  
-frld         |                |      |   |                 |                                       |                                  
-sist         |                |      |   |                 |                                       |                                  
-tbif1        |                |      |   |                 |                                       |                                  
-tbif2        |                |      |   |                 |                                       |                                  
-tbif3        |                |      |   |                 |                                       |                                  
-ui_ice       |                |      |   |                 |                                       |                                  
-vi_ice       |                |      |   |                 |                                       |                                  
-qstoif       |                |      |   |                 |                                       |                                  
-fsbbq        |                |      |   |                 |                                       |                                  
-stress1_i    |                |      |   |                 |                                       |                                  
-stress2_i    |                |      |   |                 |                                       |                                  
-stress12_i   |                |      |   |                 |                                       |                                  
-sxice        |                |      |   |                 |                                       |                                  
-syice        |                |      |   |                 |                                       |                                  
-sxxice       |                |      |   |                 |                                       |                                  
-syyice       |                |      |   |                 |                                       |                                  
-sxyice       |                |      |   |                 |                                       |                                  
-sxsn         |                |      |   |                 |                                       |                                  
-sysn         |                |      |   |                 |                                       |                                  
-sxxsn        |                |      |   |                 |                                       |                                  
-syysn        |                |      |   |                 |                                       |                                  
-sxysn        |                |      |   |                 |                                       |                                  
-sxa          |                |      |   |                 |                                       |                                  
-sya          |                |      |   |                 |                                       |                                  
-sxxa         |                |      |   |                 |                                       |                                  
-syya         |                |      |   |                 |                                       |                                  
-sxya         |                |      |   |                 |                                       |                                  
-sxc0         |                |      |   |                 |                                       |                                  
-syc0         |                |      |   |                 |                                       |                                  
-sxxc0        |                |      |   |                 |                                       |                                  
-syyc0        |                |      |   |                 |                                       |                                  
-sxyc0        |                |      |   |                 |                                       |                                  
-sxc1         |                |      |   |                 |                                       |                                  
-syc1         |                |      |   |                 |                                       |                                  
-sxxc1        |                |      |   |                 |                                       |                                  
-syyc1        |                |      |   |                 |                                       |                                  
-sxyc1        |                |      |   |                 |                                       |                                  
-sxc2         |                |      |   |                 |                                       |                                  
-syc2         |                |      |   |                 |                                       |                                  
-sxxc2        |                |      |   |                 |                                       |                                  
-syyc2        |                |      |   |                 |                                       |                                  
-sxyc2        |                |      |   |                 |                                       |                                  
-sxst         |                |      |   |                 |                                       |                                  
-syst         |                |      |   |                 |                                       |                                  
-sxxst        |                |      |   |                 |                                       |                                  
-syyst        |                |      |   |                 |                                       |                                  
-sxyst        |                |      |   |                 |                                       |                                  
+# name       | units          | axis | point | standard name                | long name          | interpolation
+X            | 1              | X    |   | projection_x_coordinate          |                    |                      
+Y            | 1              | Y    |   | projection_y_coordinate          |                    |                      
+Z            | 1              | Z    |   | projection_z_coordinate          |                    |                      
+T            | 1              | T    |   | projection_t_coordinate          |                    |                      
+nav_lon      | degrees_east   | XY   | T | longitude                        | Longitude          | cubic                      
+nav_lat      | degrees_north  | XY   | T | latitude                         | Latitude           | cubic         
+nav_lev      | model_levels   | Z    | T |                                  | Model levels       | cubic        
+deptht       | m              | Z    | T | depth                            | Vertical T levels  |
+time_counter |                | T    |   | time                             | Time axis          | 
+Bathymetry   | m              | XY   | T | bathymetry                       | Bathymetry         | cubic         
+votemper     | degree_Celsius | XYZT | T | sea_water_potential_temperature  | Temperature        | cubic         
+vozocrtx     | m s-1          | XYZT | U |                                  | Zonal velocity     | cubic         
+vomecrty     | m s-1          | XYZT | V |                                  | Meridional velocity| cubic         
+vosaline     | PSU            | XYZT | T | sea_water_salinity               | Salinity           | cubic         
+sossheig     | m              | XYT  | T | sea_surface_height               | Sea Surface Height | cubic         
+glamt        | degrees_east   | XY   | T |                                  | Longitude_T        | cubic
+glamu        | degrees_east   | XY   | U |                                  | Longitude_U        | cubic            
+glamv        | degrees_east   | XY   | V |                                  | Longitude_V        | cubic          
+glamf        | degrees_east   | XY   | F |                                  | Longitude_F        | cubic         
+gphit        | degrees_north  | XY   | T |                                  | Latitude_T         | cubic         
+gphiu        | degrees_north  | XY   | U |                                  | Latitude_U         | cubic        
+gphiv        | degrees_north  | XY   | V |                                  | Latitude_V         | cubic        
+gphif        | degrees_north  | XY   | F |                                  | Latitude_F         | cubic        
+e1t          | m              | XY   | T |                                  |                    | cubic/rhoi    
+e1u          | m              | XY   | U |                                  |                    | cubic/rhoi     
+e1v          | m              | XY   | V |                                  |                    | cubic/rhoi      
+e1f          | m              | XY   | F |                                  |                    | cubic/rhoi    
+e2t          | m              | XY   | T |                                  |                    | cubic/rhoj      
+e2u          | m              | XY   | U |                                  |                    | cubic/rhoj      
+e2v          | m              | XY   | V |                                  |                    | cubic/rhoj     
+e2f          | m              | XY   | F |                                  |                    | cubic/rhoj      
+tmask        |                | XYZ  | T |                                  |                    | nearest       
+umask        |                | XYZ  | U |                                  |                    | nearest       
+vmask        |                | XYZ  | V |                                  |                    | nearest       
+fmask        |                | XYZ  | F |                                  |                    | nearest       
+weight       |                | XY   | T |                                  |                    |               
+kt           |                |      |   |                                  |                    |               
+ndastp       |                |      |   |                                  |                    |               
+adatrj       |                |      |   |                                  |                    |               
+kt           |                |      |   |                                  |                    |               
+rdt          |                |      |   |                                  |                    |               
+rdttra1      |                |      |   |                                  |                    |               
+utau_b       |                | XYT  | U |surface_downward_eastward_stress  |                    |               
+vtau_b       |                | XYT  | V |surface_downward_northward_stress |                    |               
+qns_b        |                | XYT  | T |                                  |                    |               
+emp_b        |                | XYT  | T |                                  |                    |               
+sfx_b        |                | XYT  | T |                                  |                    |               
+en           |                | XYZT | T |                                  |                    |               
+avt          |                | XYZT | T |                                  |                    |               
+avm          |                | XYZT | T |                                  |                    |               
+avmu         |                | XYZT | T |                                  |                    |               
+avmv         |                | XYZT | T |                                  |                    |               
+dissl        |                | XYZT | T |                                  |                    |               
+sbc_hc_b     |                | XYT  | T |                                  |                    |               
+sbc_sc_b     |                | XYT  | T |                                  |                    |               
+gcx          |                | XYT  | T |                                  |                    |               
+gcxb         |                | XYT  | T |                                  |                    |               
+ub           |                | XYZT | U |                                  |                    |               
+vb           |                | XYZT | V |                                  |                    |               
+tb           |                | XYZT | T |                                  |                    |               
+sb           |                | XYZT | T |                                  |                    |               
+rotb         |                | XYZT | T |                                  |                    |               
+hdivb        |                | XYZT | T |                                  |                    |               
+sshb         |                | XYT  | T |                                  |                    |               
+un           |                | XYZT | U |                                  |                    |               
+vn           |                | XYZT | V |                                  |                    |               
+tn           |                | XYZT | T |                                  |                    |               
+sn           |                | XYZT | T |                                  |                    |               
+rotn         |                | XYZT | T |                                  |                    |               
+hdivn        |                | XYZT | T |                                  |                    |               
+sshn         |                | XYT  | T |                                  |                    |               
+rhop         |                | XYZT | T |                                  |                    |               
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 10251)
@@ -81,6 +81,5 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date November, 2014 
-!> - Fix memory leaks bug
+!> @date November, 2014 - Fix memory leaks bug
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -131,10 +130,10 @@
       INTEGER(i4)       :: i_type = 0        !< attribute type
       INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute
-      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR
+      CHARACTER(LEN=lc) :: c_value = "none"  !< attribute value if type CHAR
       REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE
    END TYPE TATT
 
    INTERFACE att_init
-      MODULE PROCEDURE att__init_c    
+      MODULE PROCEDURE att__init_c
       MODULE PROCEDURE att__init_dp
       MODULE PROCEDURE att__init_dp_0d
@@ -182,5 +181,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !> - use function instead of overload assignment operator 
+   !>    - use function instead of overload assignment operator 
    !> (to avoid memory leak) 
    !
@@ -235,5 +234,5 @@
 
       ! local variable
-      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value
       !----------------------------------------------------------------
 
@@ -301,7 +300,6 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 
-   !> - bug fix with use of id read from attribute structure
-   !>
+   !> @date September, 2014 - bug fix with use of id read from attribute structure
+   !
    !> @param[in] td_att    array of attribute structure
    !> @param[in] cd_name   attribute name
@@ -357,6 +355,6 @@
 
       att__init_c%c_name=TRIM(ADJUSTL(cd_name))
+
       att__init_c%i_type=NF90_CHAR
-
       att__init_c%c_value=TRIM(ADJUSTL(cd_value))
       att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) )
@@ -370,5 +368,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> @dtae November, 2013 - Initial Version
    !
    !> @param[in] cd_name   attribute name
@@ -1070,6 +1068,5 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 
-   !> - take into account type of attribute.
+   !> @date September, 2014 - take into account type of attribute.
    !
    !> @param[in] td_att attribute structure
@@ -1117,5 +1114,4 @@
 
             CASE(NF90_CHAR)
-
                cl_value=td_att%c_value
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/boundary.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 10251)
@@ -26,7 +26,7 @@
 !>       - ld_west  is logical to force used of north boundary [optional]
 !>       - cd_north is string character description of north boundary [optional]
-!>       - cd_south is string character description of south boundary [optional]
-!>       - cd_east  is string character description of east  boundary [optional]
-!>       - cd_west  is string character description of west  boundary [optional]
+!>       - cd_south is string character description of north boundary [optional]
+!>       - cd_east  is string character description of north boundary [optional]
+!>       - cd_west  is string character description of north boundary [optional]
 !>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
 !>
@@ -36,7 +36,4 @@
 !>    to know if boundary is use:<br/>
 !>    - tl_bdy\%l_use
-!>
-!>    to know if boundary come from namelist (cn_north,..):<br/>
-!>    - tl_bdy\%l_nam
 !>
 !>    to get the number of segment in boundary:<br/>
@@ -108,12 +105,6 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date September, 2014 
-!> - add boundary description
-!> @date November, 2014 
-!> - Fix memory leaks bug
-!> @date February, 2015 
-!> - Do not change indices read from namelist
-!> - Change string character format of boundary read from namelist, 
-!>  see boundary__get_info
+!> @date September, 2014 - add boundary description
+!> @date November, 2014 - Fix memory leaks bug
 !> 
 !> @todo add schematic to boundary structure description
@@ -166,5 +157,5 @@
    PRIVATE :: seg__init       ! initialise segment structure
    PRIVATE :: seg__clean      ! clean segment structure
-   PRIVATE :: seg__clean_unit ! clean one segment structure
+   PRIVATE :: seg__clean_unit ! clean segment structure
    PRIVATE :: seg__clean_arr  ! clean array of segment structure
    PRIVATE :: seg__copy       ! copy segment structure in another
@@ -182,10 +173,8 @@
       CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal
       LOGICAL           :: l_use  = .FALSE.     !< boundary use or not 
-      LOGICAL           :: l_nam  = .FALSE.     !< boundary get from namelist
       INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary
       TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure
    END TYPE TBDY
 
-   ! module variable
    INTEGER(i4), PARAMETER :: im_width=10
 
@@ -234,5 +223,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !> - use function instead of overload assignment operator 
+   !>    - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -271,5 +260,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !> - use function instead of overload assignment operator 
+   !>    - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -364,20 +353,8 @@
    END SUBROUTINE boundary__clean_arr
    !------------------------------------------------------------------- 
-   !> @brief This function put cardinal name and date inside file name.
+   !> @brief This function put cardinal name inside file name.
    ! 
    !> @details 
-   !>    Examples :
-   !>       cd_file="boundary.nc"
-   !>       cd_card="west" 
-   !>       id_seg =2
-   !>       cd_date=y2015m07d16
-   !> 
-   !>       function return "boundary_west_2_y2015m07d16.nc"
-   !> 
-   !>       cd_file="boundary.nc"
-   !>       cd_card="west" 
-   !> 
-   !>       function return "boundary_west.nc"
-   !> 
+   ! 
    !> @author J.Paul 
    !> @date November, 2013 - Initial Version 
@@ -408,8 +385,4 @@
       CHARACTER(LEN=lc) :: cl_date
       CHARACTER(LEN=lc) :: cl_name
-
-      INTEGER(i4)       :: il_ind
-      INTEGER(i4)       :: il_indend
-
       ! loop indices 
       !---------------------------------------------------------------- 
@@ -427,31 +400,18 @@
          cl_suffix=fct_split(TRIM(cl_basename),2,'.')
          
-         ! add segment number
          IF( PRESENT(id_seg) )THEN
-            cl_segnum="_"//TRIM(fct_str(id_seg))
+            cl_segnum="_"//TRIM(fct_str(id_seg))//"_"
          ELSE
             cl_segnum=""
          ENDIF
 
-         ! add date
          IF( PRESENT(cd_date) )THEN
-            cl_date="_"//TRIM(ADJUSTL(cd_date))
+            cl_date=TRIM(ADJUSTL(cd_date))
          ELSE
             cl_date=""
          ENDIF
 
-         ! special case for obcdta
-         il_ind=INDEX(cl_base,'_obcdta_')
-         IF( il_ind/=0 )THEN
-            il_ind=il_ind-1+8
-            il_indend=LEN_TRIM(cl_base)
-
-            cl_name=TRIM(cl_base(1:il_ind))//TRIM(cd_card)//&
-               &     TRIM(cl_segnum)//"_"//TRIM(cl_base(il_ind+1:il_indend))//&
-               &     TRIM(cl_date)//"."//TRIM(cl_suffix)
-         ELSE
-            cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//&
-               &     TRIM(cl_date)//"."//TRIM(cl_suffix)
-         ENDIF
+         cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//&
+         &        TRIM(cl_date)//"."//TRIM(cl_suffix)
 
          boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name)
@@ -482,6 +442,6 @@
    !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2'
    !>
-   !> @note Boundaries are compute on T point, but expressed on U,V point.
-   !> change will be done to get data on other point when need be. 
+   !> @note boundaries are compute on T point. change will be done to get data
+   !> on other point when need be. 
    !>
    !> @author J.Paul 
@@ -621,13 +581,8 @@
 
                ! get namelist information
-               tl_tmp=boundary__get_info(cl_card(jk),jk)
-
-               ! get segments indices
+               tl_tmp=boundary__get_info(cl_card(jk))
                DO ji=1,tl_tmp%i_nseg
                   CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji))
                ENDDO
-               ! indices from namelist or not
-               tl_bdy(jk)%l_nam=tl_tmp%l_nam
-
                CALL boundary_clean(tl_tmp)
 
@@ -687,10 +642,9 @@
    !> @return boundary structure
    !------------------------------------------------------------------- 
-   FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg ) 
+   FUNCTION boundary__init( cd_card, ld_use, td_seg ) 
       IMPLICIT NONE 
       ! Argument
       CHARACTER(LEN=*), INTENT(IN) :: cd_card
       LOGICAL         , INTENT(IN), OPTIONAL :: ld_use 
-      LOGICAL         , INTENT(IN), OPTIONAL :: ld_nam 
       TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg
 
@@ -710,7 +664,4 @@
             boundary__init%l_use=.TRUE.
             IF( PRESENT(ld_use) ) boundary__init%l_use=ld_use
-
-            boundary__init%l_nam=.FALSE.
-            IF( PRESENT(ld_nam) ) boundary__init%l_nam=ld_nam
 
             IF( PRESENT(td_seg) )THEN
@@ -827,21 +778,16 @@
    !> orthogonal index, first and last indices, of each segment. 
    !> And also the width of all segments of this boundary.
-   !>   cn_north='index1,first1:last1(width)|index2,first2:last2'
+   !>   cn_north='index1,first1,last1(width)|index2,first2,last2'
    !> 
    !> @author J.Paul 
    !> @date November, 2013 - Initial Version 
-   !> @date february, 2015 
-   !> - do not change indices read from namelist
-   !> - change format cn_north
    ! 
    !> @param[in] cd_card   boundary description
-   !> @param[in] id_jcard  boundary index
    !> @return boundary structure
    !------------------------------------------------------------------- 
-   FUNCTION boundary__get_info(cd_card, id_jcard) 
+   FUNCTION boundary__get_info(cd_card) 
       IMPLICIT NONE 
       ! Argument 
       CHARACTER(LEN=lc), INTENT(IN) :: cd_card
-      INTEGER(i4)      , INTENT(IN) :: id_jcard
 
       ! function 
@@ -856,5 +802,4 @@
       CHARACTER(LEN=lc) :: cl_index
       CHARACTER(LEN=lc) :: cl_width
-      CHARACTER(LEN=lc) :: cl_tmp
       CHARACTER(LEN=lc) :: cl_first
       CHARACTER(LEN=lc) :: cl_last 
@@ -873,9 +818,4 @@
       ! width should be the same for all segment of one boundary
       IF( TRIM(cl_seg)   /= '' )THEN
-
-         ! initialise boundary
-         ! temporaty boundary, so it doesn't matter which caridnal is used
-         boundary__get_info=boundary__init('north',ld_nam=.TRUE.)
-
          il_ind1=SCAN(fct_lower(cl_seg),'(')
          IF( il_ind1 /=0 )THEN
@@ -891,5 +831,4 @@
             ENDIF
          ENDIF
-
       ENDIF 
 
@@ -900,5 +839,5 @@
          il_ind1=SCAN(fct_lower(cl_index),'(')
          IF( il_ind1 /=0 )THEN
-            il_ind2=SCAN(fct_lower(cl_index),')')
+            il_ind2=SCAN(fct_lower(cl_index),'(')
             IF( il_ind2 /=0 )THEN
                cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:))
@@ -909,13 +848,9 @@
          ENDIF
       
-         
-         cl_tmp=fct_split(cl_seg,2,',')
-
-
-         cl_first=fct_split(cl_tmp,1,':')
+         cl_first=fct_split(cl_seg,2,',')
          ! remove potential width information
          il_ind1=SCAN(fct_lower(cl_first),'(')
          IF( il_ind1 /=0 )THEN
-            il_ind2=SCAN(fct_lower(cl_first),')')
+            il_ind2=SCAN(fct_lower(cl_first),'(')
             IF( il_ind2 /=0 )THEN
                cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:))
@@ -926,9 +861,9 @@
          ENDIF         
          
-         cl_last =fct_split(cl_tmp,2,':')
+         cl_last =fct_split(cl_seg,3,',')
          ! remove potential width information
          il_ind1=SCAN(fct_lower(cl_last),'(')
          IF( il_ind1 /=0 )THEN
-            il_ind2=SCAN(fct_lower(cl_last),')')
+            il_ind2=SCAN(fct_lower(cl_last),'(')
             IF( il_ind2 /=0 )THEN
                cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:))
@@ -944,10 +879,4 @@
          IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first
          IF( TRIM(cl_last)  /= '' ) READ(cl_last ,*) tl_seg%i_last
-
-         ! index expressed on U,V point, move on T point.
-         SELECT CASE(id_jcard)
-            CASE(jp_north, jp_east)
-               tl_seg%i_index=tl_seg%i_index+1
-         END SELECT
 
          IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. &
@@ -1014,5 +943,5 @@
 
       DO jk=1,ip_ncard
-         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN
+         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%i_nseg > 1 )THEN
             ! nothing to be done
          ELSE
@@ -1551,5 +1480,5 @@
       il_max(jp_east )=td_var%t_dim(2)%i_len
       il_max(jp_west )=td_var%t_dim(2)%i_len
- 
+      
       il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost
       il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost
@@ -1586,5 +1515,5 @@
          ENDIF
       ENDDO
- 
+      
       CALL boundary_check_corner(td_bdy, td_var)
 
@@ -1721,5 +1650,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !> - use function instead of overload assignment operator 
+   !>    - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -1758,5 +1687,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !> - use function instead of overload assignment operator 
+   !>    - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 10251)
@@ -20,11 +20,5 @@
 !>    ./SIREN/bin/create_bathy create_bathy.nam
 !> @endcode
-!> <br/>    
-!> \image html  bathy_40.png 
-!> \image latex bathy_30.png
-!>
-!> @note 
-!>    you could find a template of the namelist in templates directory.
-!>
+!>    
 !>    create_bathy.nam comprise 7 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -43,5 +37,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal','none')
+!> 'warning','error','fatal')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -58,21 +52,18 @@
 !>       - cn_coord1 : coordinate file
 !>       - in_perio1 : periodicity index
-!>       - ln_fillclosed : fill closed sea or not (default is .TRUE.)
+!>       - ln_fillclosed : fill closed sea or not
 !>
 !>    * _variable namelist (namvar)_:<br/>
 !>       - cn_varinfo : list of variable and extra information about request(s) 
 !>       to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character
-!>          (separated by ',').<br/>
+!>          each elements of *cn_varinfo* is a string character.<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - int = interpolation method
-!>             - ext = extrapolation method
-!>             - flt = filter method
-!>             - min = minimum value
-!>             - max = maximum value
-!>             - unt = new units
-!>             - unf = unit scale factor (linked to new units)
+!>             - interpolation method
+!>             - extrapolation method
+!>             - filter method
+!>             - > minimum value
+!>             - < maximum value
 !>
 !>                requests must be separated by ';'.<br/>
@@ -81,5 +72,5 @@
 !>          informations about available method could be find in @ref interp,
 !>          @ref extrap and @ref filter modules.<br/>
-!>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0'
+!>          Example: 'Bathymetry: 2*hamming(2,3); > 0'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -99,4 +90,5 @@
 !>                - ',' for line
 !>                - '/' for row
+!>                - '\' for level<br/>
 !>                Example:<br/>
 !>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
@@ -107,4 +99,7 @@
 !>             - 'Bathymetry:gridT.nc'
 !>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000'
+!>
+!>          \image html  bathy_40.png 
+!>          \image latex bathy_30.png
 !>
 !>    * _nesting namelist (namnst)_:<br/>
@@ -124,13 +119,5 @@
 !> - add header for user
 !> - Bug fix, compute offset depending of grid point
-!> @date June, 2015
-!> - extrapolate all land points.
-!> - allow to change unit.
 !
-!> @todo
-!> - use create_bathy_check_depth as in create_boundary
-!> - use create_bathy_check_time  as in create_boundary
-!> - check tl_multi is not empty
-!>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 !----------------------------------------------------------------------
@@ -495,10 +482,5 @@
    ENDIF
 
-   ! use additional request
    DO jk=1,tl_multi%i_nvar
-
-         ! change unit and apply factor
-         CALL var_chg_unit(tl_var(jk))
-
          ! forced min and max value
          CALL var_limit_value(tl_var(jk))
@@ -575,5 +557,5 @@
 
    ! add other variables
-   DO jk=tl_multi%i_nvar,1,-1
+   DO jk=1,tl_multi%i_nvar
       CALL file_add_var(tl_fileout, tl_var(jk))
       CALL var_clean(tl_var(jk))
@@ -641,5 +623,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -777,5 +759,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -896,5 +878,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_var    variable structure
@@ -915,10 +897,10 @@
       IMPLICIT NONE
       ! Argument
-      TYPE(TVAR)                 , INTENT(IN) :: td_var  
-      TYPE(TMPP)                 , INTENT(IN) :: td_mpp 
-      INTEGER(i4)                , INTENT(IN) :: id_imin
-      INTEGER(i4)                , INTENT(IN) :: id_imax
-      INTEGER(i4)                , INTENT(IN) :: id_jmin
-      INTEGER(i4)                , INTENT(IN) :: id_jmax
+      TYPE(TVAR) , INTENT(IN) :: td_var  
+      TYPE(TMPP) , INTENT(IN) :: td_mpp 
+      INTEGER(i4), INTENT(IN) :: id_imin
+      INTEGER(i4), INTENT(IN) :: id_imax
+      INTEGER(i4), INTENT(IN) :: id_jmin
+      INTEGER(i4), INTENT(IN) :: id_jmax
       INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset
       INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho
@@ -1007,5 +989,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1091,5 +1073,7 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var )
+      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), &
+      &                               id_rho=id_rho(:),         &
+      &                               id_iext=il_iext, id_jext=il_jext )
 
       ! interpolate Bathymetry
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90	(revision 10251)
@@ -23,11 +23,5 @@
 !>    ./SIREN/bin/create_boundary create_boundary.nam
 !> @endcode
-!>  <br/> 
-!> \image html  boundary_NEATL36_70.png 
-!> \image latex boundary_NEATL36_70.png
-!>
-!> @note 
-!>    you could find a template of the namelist in templates directory.
-!>
+!>    
 !>    create_boundary.nam comprise 9 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -48,5 +42,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal','none')
+!> 'warning','error','fatal')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -85,14 +79,12 @@
 !>    * _variable namelist (namvar)_:<br/>
 !>       - cn_varinfo : list of variable and extra information about request(s)
-!>          to be used (separated by ',').<br/>
+!> to be used.<br/>
 !>          each elements of *cn_varinfo* is a string character.<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - int = interpolation method
-!>             - ext = extrapolation method
-!>             - flt = filter method
-!>             - unt = new units
-!>             - unf = unit scale factor (linked to new units)
+!>             - interpolation method
+!>             - extrapolation method
+!>             - filter method
 !>
 !>                requests must be separated by ';'.<br/>
@@ -102,5 +94,5 @@
 !>          @ref extrap and @ref filter.<br/>
 !>
-!>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 'vosaline:int=cubic'
+!>          Example: 'votemper:linear;hann;dist_weight', 'vosaline:cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -144,9 +136,9 @@
 !>          segments are separated by '|'.<br/>
 !>          each segments of the boundary is composed of:
-!>             - indice of velocity (orthogonal to boundary .ie. 
-!>                for north boundary, J-indice). 
-!>             - indice of segemnt start (I-indice for north boundary) 
-!>             - indice of segment end   (I-indice for north boundary)<br/>
-!>                indices must be separated by ':' .<br/>
+!>             - orthogonal indice (.ie. for north boundary,
+!>             J-indice where boundary are). 
+!>             - first indice of boundary (I-indice for north boundary) 
+!>             - last  indice of boundary (I-indice for north boundary)<br/>
+!>                indices must be separated by ',' .<br/>
 !>             - optionally, boundary size could be added between '(' and ')' 
 !>             in the first segment defined.
@@ -155,26 +147,19 @@
 !>
 !>          Examples:
-!>             - cn_north='index1,first1:last1(width)'
-!>             - cn_north='index1(width),first1:last1|index2,first2:last2'
-!>             \image html  boundary_50.png 
-!>             \image latex boundary_50.png
+!>             - cn_north='index1,first1,last1(width)'
+!>             - cn_north='index1(width),first1,last1|index2,first2,last2'
+!>
+!>          \image html  boundary_50.png 
+!>          \image latex boundary_50.png
+!>
 !>       - cn_south  : south boundary indices on fine grid
 !>       - cn_east   : east  boundary indices on fine grid
 !>       - cn_west   : west  boundary indices on fine grid
 !>       - ln_oneseg : use only one segment for each boundary or not
-!>
-!>    * _output namelist (namout)_:<br/>
+!>       - in_extrap : number of mask point to be extrapolated
+!>
+!>   * _output namelist (namout)_:<br/>
 !>       - cn_fileout : fine grid boundary basename
 !>         (cardinal and segment number will be automatically added)
-!>       - dn_dayofs  : date offset in day (change only ouput file name)
-!>       - ln_extrap  : extrapolate land point or not
-!>
-!>          Examples: 
-!>             - cn_fileout=boundary.nc<br/>
-!>                if time_counter (16/07/2015 00h) is read on input file (see varfile), 
-!>                west boundary will be named boundary_west_y2015m07d16
-!>             - dn_dayofs=-2.<br/>
-!>                if you use day offset you get boundary_west_y2015m07d14
-!>       
 !>
 !> @author J.Paul
@@ -184,10 +169,5 @@
 !> - add header for user
 !> - take into account grid point to compue boundaries
-!> - reorder output dimension for north and south boundaries
-!> @date June, 2015
-!> - extrapolate all land points, and add ln_extrap in namelist.
-!> - allow to change unit.
-!> @date July, 2015
-!> - add namelist parameter to shift date of output file name.  
+!> - reorder output dimension for north and south boundaries 
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -211,5 +191,5 @@
    USE dom                             ! domain manager
    USE grid                            ! grid manager
-   USE vgrid                           ! vertical grid manager
+   USE vgrid                           ! vartical grid manager
    USE extrap                          ! extrapolation manager
    USE interp                          ! interpolation manager
@@ -233,4 +213,5 @@
    INTEGER(i4)                                        :: il_status
    INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_dim
    INTEGER(i4)                                        :: il_imin0
    INTEGER(i4)                                        :: il_imax0
@@ -258,6 +239,4 @@
 
    TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
-
-   TYPE(TDATE)                                        :: tl_date
    
    TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
@@ -286,37 +265,22 @@
    ! namelist variable
    ! namlog
-   CHARACTER(LEN=lc)  :: cn_logfile = 'create_boundary.log' 
-   CHARACTER(LEN=lc)  :: cn_verbosity = 'warning' 
-   INTEGER(i4)        :: in_maxerror = 5
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_boundary.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
 
    ! namcfg
-   CHARACTER(LEN=lc)  :: cn_varcfg = 'variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg' 
 
    ! namcrs
-   CHARACTER(LEN=lc)  :: cn_coord0 = '' 
-   INTEGER(i4)        :: in_perio0 = -1
+   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
+   INTEGER(i4)                             :: in_perio0 = -1
 
    ! namfin
-   CHARACTER(LEN=lc)  :: cn_coord1 = '' 
-   CHARACTER(LEN=lc)  :: cn_bathy1 = '' 
-   INTEGER(i4)        :: in_perio1 = -1
+   CHARACTER(LEN=lc)                       :: cn_coord1 = '' 
+   CHARACTER(LEN=lc)                       :: cn_bathy1 = '' 
+   INTEGER(i4)                             :: in_perio1 = -1
 
    !namzgr
-   REAL(dp)          :: dn_pp_to_be_computed = 0._dp
-   REAL(dp)          :: dn_ppsur     = -3958.951371276829_dp
-   REAL(dp)          :: dn_ppa0      =   103.9530096000000_dp
-   REAL(dp)          :: dn_ppa1      =     2.4159512690000_dp
-   REAL(dp)          :: dn_ppa2      =   100.7609285000000_dp
-   REAL(dp)          :: dn_ppkth     =    15.3510137000000_dp
-   REAL(dp)          :: dn_ppkth2    =    48.0298937200000_dp
-   REAL(dp)          :: dn_ppacr     =     7.0000000000000_dp
-   REAL(dp)          :: dn_ppacr2    =    13.000000000000_dp
-   REAL(dp)          :: dn_ppdzmin   = 6._dp
-   REAL(dp)          :: dn_pphmax    = 5750._dp
-   INTEGER(i4)       :: in_nlevel    = 75
-
-   !namzps
-   REAL(dp)          :: dn_e3zps_min = 25._dp
-   REAL(dp)          :: dn_e3zps_rat = 0.2_dp
+   INTEGER(i4)                             :: in_nlevel = 75
 
    ! namvar
@@ -325,22 +289,21 @@
 
    ! namnst
-   INTEGER(i4)       :: in_rhoi  = 0
-   INTEGER(i4)       :: in_rhoj  = 0
+   INTEGER(i4)                             :: in_rhoi  = 0
+   INTEGER(i4)                             :: in_rhoj  = 0
 
    ! nambdy
-   LOGICAL           :: ln_north   = .TRUE.
-   LOGICAL           :: ln_south   = .TRUE.
-   LOGICAL           :: ln_east    = .TRUE.
-   LOGICAL           :: ln_west    = .TRUE.
-   CHARACTER(LEN=lc) :: cn_north   = ''
-   CHARACTER(LEN=lc) :: cn_south   = ''
-   CHARACTER(LEN=lc) :: cn_east    = ''
-   CHARACTER(LEN=lc) :: cn_west    = ''
-   LOGICAL           :: ln_oneseg  = .TRUE.
+   LOGICAL                                 :: ln_north   = .TRUE.
+   LOGICAL                                 :: ln_south   = .TRUE.
+   LOGICAL                                 :: ln_east    = .TRUE.
+   LOGICAL                                 :: ln_west    = .TRUE.
+   CHARACTER(LEN=lc)                       :: cn_north   = ''
+   CHARACTER(LEN=lc)                       :: cn_south   = ''
+   CHARACTER(LEN=lc)                       :: cn_east    = ''
+   CHARACTER(LEN=lc)                       :: cn_west    = ''
+   LOGICAL                                 :: ln_oneseg  = .TRUE.
+   INTEGER(i4)                             :: in_extrap  = 0
 
    ! namout
-   CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc' 
-   REAL(dp)          :: dn_dayofs  = 0._dp
-   LOGICAL           :: ln_extrap  = .FALSE.
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc' 
    !-------------------------------------------------------------------
 
@@ -356,5 +319,5 @@
    &  cn_coord0,     &  !< coordinate file
    &  in_perio0         !< periodicity index
- 
+   
    NAMELIST /namfin/ &  !< fine grid namelist
    &  cn_coord1,     &  !< coordinate file
@@ -363,25 +326,10 @@
  
    NAMELIST /namzgr/ &
-   &  dn_pp_to_be_computed, &
-   &  dn_ppsur,     &
-   &  dn_ppa0,      &
-   &  dn_ppa1,      &
-   &  dn_ppa2,      &
-   &  dn_ppkth,     &
-   &  dn_ppkth2,    &
-   &  dn_ppacr,     &
-   &  dn_ppacr2,    &
-   &  dn_ppdzmin,   &
-   &  dn_pphmax,    &
-   &  in_nlevel         !< number of vertical level
-
-   NAMELIST /namzps/ &
-   &  dn_e3zps_min, &
-   &  dn_e3zps_rat
+   &  in_nlevel
 
    NAMELIST /namvar/ &  !< variable namelist
    &  cn_varinfo,    &  !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' )
    &  cn_varfile        !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' ) 
- 
+   
    NAMELIST /namnst/ &  !< nesting namelist
    &  in_rhoi,       &  !< refinement factor in i-direction
@@ -397,10 +345,9 @@
    &  cn_east ,      &  !< east  boundary indices on fine grid
    &  cn_west ,      &  !< west  boundary indices on fine grid
-   &  ln_oneseg         !< use only one segment for each boundary or not
+   &  ln_oneseg,     &  !< use only one segment for each boundary or not
+   &  in_extrap         !< number of mask point to be extrapolated
 
    NAMELIST /namout/ &  !< output namelist
-   &  cn_fileout,    &  !< fine grid boundary file basename   
-   &  dn_dayofs,     &  !< date offset in day (change only ouput file name)
-   &  ln_extrap         !< extrapolate or not
+   &  cn_fileout    !< fine grid boundary file basename   
    !-------------------------------------------------------------------
 
@@ -501,16 +448,7 @@
    ! check
    ! check output file do not already exist
-   ! WARNING: do not work when use time to create output file name
    DO jk=1,ip_ncard
       cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
       &                                TRIM(cp_card(jk)), 1 )
-      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
-      IF( ll_exist )THEN
-         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
-         &  " already exist.")
-      ENDIF
-
-      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-      &                                TRIM(cp_card(jk)) )
       INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
       IF( ll_exist )THEN
@@ -552,10 +490,9 @@
 
    CALL iom_mpp_open(tl_bathy1)
- 
+   
    tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry')
- 
+   
    CALL iom_mpp_close(tl_bathy1)
 
-   ! get boundaries indices
    tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, &
    &                                cn_north, cn_south, cn_east, cn_west, &
@@ -568,8 +505,8 @@
    tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
 
-   ! get coordinate for each segment of each boundary
+   ! get coordinate on each segment of each boundary
    ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) )
    ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) )
- 
+   
    DO jl=1,ip_ncard
       IF( tl_bdy(jl)%l_use )THEN
@@ -579,11 +516,4 @@
             tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, &
             &                                            tl_bdy(jl), jk )
-
-            IF( .NOT. ln_extrap )THEN
-               ! get fine grid level
-               tl_seglvl1(:,jk,jl)= &
-                  & create_boundary_get_level( tl_level(:), &
-                  &                            tl_segdom1(:,jk,jl))
-            ENDIF
 
             ! add extra band to fine grid domain (if possible)
@@ -593,4 +523,8 @@
                &                  il_rho(jp_I), il_rho(jp_J))
             ENDDO
+
+            ! get fine grid level
+            tl_seglvl1(:,jk,jl)=create_boundary_get_level( tl_level(:), &
+                                                           tl_segdom1(:,jk,jl))
 
          ENDDO
@@ -660,4 +594,8 @@
                         &                          in_nlevel )
 
+                        ! use mask
+                        CALL create_boundary_use_mask( tl_segvar1(jvar,jk,jl), &
+                        &                         tl_seglvl1(jpoint,jk,jl))
+
                         !del extra
                         CALL dom_del_extra( tl_segvar1(jvar,jk,jl), &
@@ -716,6 +654,5 @@
                   IF( tl_bdy(jl)%l_use )THEN
                      
-                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//&
-                        &  ' boundary'
+                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary'
                      DO jk=1,tl_bdy(jl)%i_nseg
                         ! compute domain on fine grid
@@ -725,6 +662,5 @@
                            
                            cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
-                           WRITE(*,'(4x,a,a)') "work on (extract) variable "//&
-                              &  TRIM(cl_name)
+                           WRITE(*,'(4x,a,a)') "work on variable "//TRIM(cl_name)
 
                            cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point
@@ -742,4 +678,5 @@
 
                            tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
+                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl))
 
                            ! open mpp files
@@ -750,4 +687,8 @@
                            &                     tl_mpp, TRIM(cl_name), tl_dom1)
 
+                           ! use mask
+                           CALL create_boundary_use_mask( &
+                           &                 tl_segvar1(jvar+jj,jk,jl), tl_lvl1)
+
                            ! del extra point
                            CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
@@ -758,14 +699,11 @@
 
                            ! add attribute to variable
-                           tl_att=att_init('src_file', &
-                              &  TRIM(fct_basename(tl_mpp%c_name)))
+                           tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att)
 
-                           tl_att=att_init('src_i_indices', &
-                              &  (/tl_dom1%i_imin, tl_dom1%i_imax/))
+                           tl_att=att_init('src_i_indices',(/tl_dom1%i_imin, tl_dom1%i_imax/))
                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att)
 
-                           tl_att=att_init('src_j_indices', &
-                              &  (/tl_dom1%i_jmin, tl_dom1%i_jmax/))
+                           tl_att=att_init('src_j_indices',(/tl_dom1%i_jmin, tl_dom1%i_jmax/))
                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att)
 
@@ -798,12 +736,11 @@
                   IF( tl_bdy(jl)%l_use )THEN
 
-                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//&
-                        &  ' boundary'
+                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary'
                      DO jk=1,tl_bdy(jl)%i_nseg
                         
                         ! for each variable of this file
                         DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
- 
-                           WRITE(*,'(4x,a,a)') "work on (interp) variable "//&
+                           
+                           WRITE(*,'(4x,a,a)') "work on variable "//&
                            &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -822,4 +759,5 @@
 
                            tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
+                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl))
 
                            CALL create_boundary_get_coord( tl_coord1, tl_dom1, &
@@ -857,6 +795,5 @@
                            &                 il_jmin0, il_jmax0 )
 
-                           ! add extra band (if possible) to compute 
-                           ! interpolation
+                           ! add extra band (if possible) to compute interpolation
                            CALL dom_add_extra(tl_dom0)
 
@@ -878,4 +815,8 @@
                            CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
                            &                   tl_dom0, il_rho(:) )
+
+                           ! use mask
+                           CALL create_boundary_use_mask( &
+                           &     tl_segvar1(jvar+jj,jk,jl), tl_lvl1)
 
                            ! del extra point on fine grid
@@ -948,11 +889,20 @@
 
    IF( jvar /= tl_multi%i_nvar )THEN
-      CALL logger_error("CREATE BOUNDARY: it seems some variable "//&
-         &  "can not be read")
+      CALL logger_error("CREATE BOUNDARY: it seems some variable can not be read")
    ENDIF
+
+   CALL var_clean(tl_seglvl1(:,:,:))
+   DEALLOCATE( tl_seglvl1 )
 
    ! write file for each segment of each boundary
    DO jl=1,ip_ncard
       IF( tl_bdy(jl)%l_use )THEN
+
+         SELECT CASE(TRIM(tl_bdy(jk)%c_card))
+         CASE('north','south')
+            il_dim=1
+         CASE('east','west')
+            il_dim=2
+         END SELECT   
 
          DO jk=1,tl_bdy(jl)%i_nseg
@@ -961,8 +911,4 @@
             &                               'T', tl_lon1, tl_lat1 )
 
-            ! force to use nav_lon, nav_lat as variable name
-            tl_lon1%c_name='nav_lon'
-            tl_lat1%c_name='nav_lat'
-
             ! del extra point on fine grid
             CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) )
@@ -978,9 +924,7 @@
             CALL boundary_swap(tl_lat1, tl_bdy(jl))
             DO jvar=1,tl_multi%i_nvar
+               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl))
 
                ! use additional request
-               ! change unit and apply factor
-               CALL var_chg_unit(tl_segvar1(jvar,jk,jl))
-
                ! forced min and max value
                CALL var_limit_value(tl_segvar1(jvar,jk,jl))
@@ -989,23 +933,9 @@
                CALL filter_fill_value(tl_segvar1(jvar,jk,jl))
 
-               IF( .NOT. ln_extrap )THEN
-                  ! use mask
-                  SELECT CASE(TRIM(tl_segvar1(jvar,jk,jl)%c_point))
-                  CASE DEFAULT !'T'
-                     jpoint=jp_T
-                  CASE('U')
-                     jpoint=jp_U
-                  CASE('V')
-                     jpoint=jp_V
-                  CASE('F')
-                     jpoint=jp_F
-                  END SELECT
-
-                  CALL create_boundary_use_mask(tl_segvar1(jvar,jk,jl), &
-                  &                             tl_seglvl1(jpoint,jk,jl))
-               ENDIF
-
-               ! swap dimension order
-               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl))
+               ! extrapolate
+               CALL extrap_fill_value( tl_segvar1(jvar,jk,jl), &
+               &                       id_iext=in_extrap,      &
+               &                       id_jext=in_extrap,      &
+               &                       id_kext=in_extrap )
 
             ENDDO
@@ -1014,32 +944,13 @@
             ! create file structure
             ! set file namearray of level variable structure
-            IF( tl_bdy(jl)%i_nseg > 1 )THEN
-               IF( ASSOCIATED(tl_time%d_value) )THEN
-                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
-                  tl_date=var_to_date(tl_time)
-                  tl_date=tl_date+dn_dayofs
-                  cl_date=date_print( tl_date, cl_fmt ) 
-
-                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-                  &                                TRIM(tl_bdy(jl)%c_card), jk,&
-                  &                                cd_date=TRIM(cl_date) )
-               ELSE
-                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-                  &                                TRIM(tl_bdy(jl)%c_card), jk )
-               ENDIF
+            IF( ASSOCIATED(tl_time%d_value) )THEN
+               cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+               cl_date=date_print( var_to_date(tl_time), cl_fmt ) 
+
+               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+               &                                TRIM(tl_bdy(jl)%c_card), jk, TRIM(cl_date) )
             ELSE
-               IF( ASSOCIATED(tl_time%d_value) )THEN
-                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
-                  tl_date=var_to_date(tl_time)
-                  tl_date=tl_date+dn_dayofs
-                  cl_date=date_print( tl_date, cl_fmt )
-
-                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-                  &                                TRIM(tl_bdy(jl)%c_card), &
-                  &                                cd_date=TRIM(cl_date) )
-               ELSE
-                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-                  &                                TRIM(tl_bdy(jl)%c_card) )
-               ENDIF
+               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+               &                                TRIM(tl_bdy(jl)%c_card), jk )
             ENDIF
             ! 
@@ -1049,9 +960,19 @@
             tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl))
 
+            CALL dim_unorder(tl_dim(:))
             SELECT CASE(TRIM(tl_bdy(jl)%c_card))
                CASE DEFAULT ! 'north','south'
                   cl_dimorder='xyzt'
+                  CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
                CASE('east','west')
                   cl_dimorder='yxzt'
+                  CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
+                  ! reorder coordinates dimension
+                  CALL var_reorder(tl_lon1,TRIM(cl_dimorder))
+                  CALL var_reorder(tl_lat1,TRIM(cl_dimorder))
+                  ! reorder other variable dimension
+                  DO jvar=1,tl_multi%i_nvar
+                     CALL var_reorder(tl_segvar1(jvar,jk,jl),TRIM(cl_dimorder))
+                  ENDDO
             END SELECT
 
@@ -1071,22 +992,16 @@
             ENDIF
             
-
-
             IF( tl_dim(3)%l_use )THEN
-               IF( ASSOCIATED(tl_depth%d_value) )THEN
-                  ! add depth
-                  CALL file_add_var(tl_fileout, tl_depth)
-               ENDIF
+               ! add depth
+               CALL file_add_var(tl_fileout, tl_depth)
             ENDIF
 
             IF( tl_dim(4)%l_use )THEN
-               IF( ASSOCIATED(tl_time%d_value) )THEN
-                  ! add time
-                  CALL file_add_var(tl_fileout, tl_time)
-               ENDIF
+               ! add time
+               CALL file_add_var(tl_fileout, tl_time)
             ENDIF
 
             ! add other variable
-            DO jvar=tl_multi%i_nvar,1,-1
+            DO jvar=1,tl_multi%i_nvar
                CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl))
                CALL var_clean(tl_segvar1(jvar,jk,jl))
@@ -1133,5 +1048,5 @@
 
             ! write file
-            CALL iom_write_file(tl_fileout, cl_dimorder)
+            CALL iom_write_file(tl_fileout)
 
             ! close file
@@ -1151,7 +1066,4 @@
    DEALLOCATE( tl_segdom1 )
    DEALLOCATE( tl_segvar1 )
-   CALL var_clean(tl_seglvl1(:,:,:))
-   DEALLOCATE( tl_seglvl1 )
-
 
    CALL mpp_clean(tl_coord1)
@@ -1170,5 +1082,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - take into account grid point to compute boundary indices
@@ -1274,10 +1186,9 @@
    !-------------------------------------------------------------------
    !> @brief
-   !> This subroutine get coordinates over boundary domain
+   !> This subroutine get coordinates over boudnary domain
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date September, 2014 
-   !> - take into account grid point
+   !> - November, 2013- Initial Version
+   !> @date September, 2014 - take into account grid point
    !>
    !> @param[in] td_coord1 coordinates file structure
@@ -1326,10 +1237,10 @@
    !-------------------------------------------------------------------
    !> @brief
-   !> This subroutine interpolate variable on boundary
+   !> This subroutine interpolate variable over boundary
    !> 
    !> @details 
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - Nov, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1385,5 +1296,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var )
+      CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext )
 
       ! interpolate Bathymetry
@@ -1392,6 +1303,5 @@
 
       ! remove extraband
-      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), &
-         &                               il_jext*id_rho(jp_J))
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
 
    END SUBROUTINE create_boundary_interp
@@ -1407,5 +1317,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -1512,5 +1422,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1565,5 +1475,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_level  array of level variable structure
@@ -1627,5 +1537,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2014 - Initial Version
+   !> - November, 2014- Initial Version
    !>
    !> @param[in] td_mpp       mpp structure
@@ -1678,5 +1588,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2014 - Initial Version
+   !> - November, 2014- Initial Version
    !>
    !> @param[in] td_mpp      mpp structure
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_coord.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 10251)
@@ -24,7 +24,4 @@
 !> @endcode
 !>    
-!> @note 
-!>    you could find a template of the namelist in templates directory.
-!>
 !>    create_coord.nam comprise 6 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -42,5 +39,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal','none')
+!> 'warning','error','fatal')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -57,12 +54,11 @@
 !>       - cn_varinfo : list of variable and extra information about request(s)
 !> to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character 
-!>          (separated by ',').<br/>
+!>          each elements of *cn_varinfo* is a string character.<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - int = interpolation method
-!>             - ext = extrapolation method
-!>             - flt = filter method
+!>             - interpolation method
+!>             - extrapolation method
+!>             - filter method
 !> 
 !>                requests must be separated by ';' .<br/>
@@ -72,6 +68,6 @@
 !>          @ref extrap and @ref filter modules.<br/>
 !>
-!>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight', 
-!>          'vosaline: int=cubic'<br/>
+!>          Example: 'votemper: linear; hann(2,3); dist_weight', 
+!>          'vosaline: cubic'<br/>
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -94,5 +90,5 @@
 !>
 !>    * _output namelist (namout)_:
-!>       - cn_fileout : output coordinate file name
+!>       - cn_fileout : output coordinate file
 !>
 !> @author J.Paul
@@ -156,4 +152,12 @@
    TYPE(TFILE)                                          :: tl_fileout
 
+   ! check 
+!   INTEGER(i4)                                          :: il_imin0
+!   INTEGER(i4)                                          :: il_imax0
+!   INTEGER(i4)                                          :: il_jmin0
+!   INTEGER(i4)                                          :: il_jmax0
+!   INTEGER(i4)      , DIMENSION(2,2)                    :: il_ind2
+!   TYPE(TMPP)                                           :: tl_mppout
+
    ! loop indices
    INTEGER(i4) :: ji
@@ -161,20 +165,15 @@
 
    ! namelist variable
-   ! namlog
    CHARACTER(LEN=lc) :: cn_logfile = 'create_coord.log' 
    CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 
    INTEGER(i4)       :: in_maxerror = 5
 
-   ! namcfg
-   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg' 
-
-   ! namcrs
    CHARACTER(LEN=lc) :: cn_coord0 = '' 
    INTEGER(i4)       :: in_perio0 = -1
 
-   ! namvar
+   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg' 
+
    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
 
-   !namnst
    INTEGER(i4)       :: in_imin0 = 0
    INTEGER(i4)       :: in_imax0 = 0
@@ -184,5 +183,4 @@
    INTEGER(i4)       :: in_rhoj  = 1
 
-   !namout
    CHARACTER(LEN=lc) :: cn_fileout= 'coord_fine.nc'
    !-------------------------------------------------------------------
@@ -307,4 +305,5 @@
 
       il_offset(:,:,:)=create_coord_get_offset(il_rho(:))
+
    ENDIF
 
@@ -349,4 +348,8 @@
       CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. )
 
+      ! do not add ghost cell. 
+      ! ghost cell already replace by value for coordinates 
+      ! CALL grid_add_ghost(tl_var(ji),tl_dom%i_ghost(:,:))
+
       ! filter
       CALL filter_fill_value(tl_var(ji))      
@@ -372,8 +375,9 @@
 
    ! add variables
-   DO ji=il_nvar,1,-1
+   DO ji=1,il_nvar
       CALL file_add_var(tl_fileout, tl_var(ji))
-      CALL var_clean(tl_var(ji))
    ENDDO
+
+   ! recompute some attribute
 
    ! add some attribute
@@ -436,4 +440,37 @@
 
    CALL file_clean(tl_fileout)
+
+!   ! check domain
+!   tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
+!   tl_mppout=mpp_init( file_init(TRIM(cn_fileout)) )
+!   CALL grid_get_info(tl_coord0)
+!   CALL iom_mpp_open(tl_mppout)
+!
+!   il_ind2(:,:)=grid_get_coarse_index( tl_coord0, tl_mppout, &
+!   &                                   id_rho=il_rho(:) )
+!
+!   il_imin0=il_ind2(1,1) ; il_imax0=il_ind2(1,2)
+!   il_jmin0=il_ind2(2,1) ; il_jmax0=il_ind2(2,2)
+!
+!   IF( il_imin0 /= in_imin0 .OR. &
+!   &   il_imax0 /= in_imax0 .OR. &
+!   &   il_jmin0 /= in_jmin0 .OR. &
+!   &   il_jmax0 /= in_jmax0 )THEN
+!      CALL logger_debug("CREATE COORD: output indices ("//&
+!      &                 TRIM(fct_str(il_imin0))//","//&
+!      &                 TRIM(fct_str(il_imax0))//") ("//&
+!      &                 TRIM(fct_str(il_jmin0))//","//&
+!      &                 TRIM(fct_str(il_jmax0))//")" ) 
+!      CALL logger_debug("CREATE COORD: input indices ("//&
+!      &                 TRIM(fct_str(in_imin0))//","//&
+!      &                 TRIM(fct_str(in_imax0))//") ("//&
+!      &                 TRIM(fct_str(in_jmin0))//","//&
+!      &                 TRIM(fct_str(in_jmax0))//")" ) 
+!      CALL logger_fatal("CREATE COORD: output domain not confrom "//&
+!      &                 "with input indices")
+!   ENDIF
+!
+!   CALL iom_mpp_close(tl_coord0)
+!   CALL iom_mpp_close(tl_mppout)
 
    ! close log file
@@ -502,6 +539,4 @@
    !> @param[in] id_iext   number of points to be extrapolated in i-direction
    !> @param[in] id_jext   number of points to be extrapolated in j-direction
-   !>
-   !> @todo check if mask is really needed
    !-------------------------------------------------------------------
    SUBROUTINE create_coord_interp( td_var,          &
@@ -591,5 +626,5 @@
 
          ! extrapolate variable
-         CALL extrap_fill_value( td_var )
+         CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext )
 
          ! interpolate variable
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 10251)
@@ -25,7 +25,4 @@
 !> @endcode
 !>    
-!> @note 
-!>    you could find a template of the namelist in templates directory.
-!>
 !>    create_restart.nam comprise 9 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -46,5 +43,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal','none')
+!> 'warning','error','fatal')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -62,4 +59,6 @@
 !>       - cn_bathy1 : bathymetry file
 !>       - in_perio1 : NEMO periodicity index
+!>       - in_extrap : number of land point to be extrapolated 
+!>       before writing file
 !>
 !>    * _vertical grid namelist (namzgr)_:<br/>
@@ -84,16 +83,13 @@
 !>       - cn_varinfo : list of variable and extra information about request(s) 
 !>       to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character
-!>          (separated by ',').<br/>
+!>          each elements of *cn_varinfo* is a string character.<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - int = interpolation method
-!>             - ext = extrapolation method
-!>             - flt = filter method
-!>             - min = minimum value
-!>             - max = maximum value
-!>             - unt = new units
-!>             - unf = unit scale factor (linked to new units)
+!>             - interpolation method
+!>             - extrapolation method
+!>             - filter method
+!>             - > minimum value
+!>             - < maximum value
 !>
 !>             requests must be separated by ';'.<br/>
@@ -102,5 +98,5 @@
 !>          informations about available method could be find in @ref interp,
 !>          @ref extrap and @ref filter.<br/>
-!>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic'
+!>          Example: 'votemper: linear; hann; dist_weight','vosaline: cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -140,8 +136,7 @@
 !>    * _output namelist (namout)_:<br/>
 !>       - cn_fileout : output file
-!>       - ln_extrap : extrapolate land point or not
+!>       - in_nproc  : total number of processor to be used
 !>       - in_niproc : i-direction number of processor
 !>       - in_njproc : j-direction numebr of processor
-!>       - in_nproc  : total number of processor to be used
 !>       - cn_type   : output format ('dimg', 'cdf')
 !>
@@ -153,7 +148,4 @@
 !> - offset computed considering grid point
 !> - add attributes in output variable
-!> @date June, 2015
-!> - extrapolate all land points, and add ln_extrap in namelist.
-!> - allow to change unit.
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -173,5 +165,5 @@
    USE iom                             ! I/O manager
    USE grid                            ! grid manager
-   USE vgrid                            ! vertical grid manager
+   USE vgrid                           ! vertical grid manager
    USE extrap                          ! extrapolation manager
    USE interp                          ! interpolation manager
@@ -257,4 +249,5 @@
    CHARACTER(LEN=lc) :: cn_bathy1 = ''
    INTEGER(i4)       :: in_perio1 = -1
+   INTEGER(i4)       :: in_extrap = 0
 
    !namzgr
@@ -286,5 +279,4 @@
    ! namout
    CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc' 
-   LOGICAL           :: ln_extrap  = .FALSE.
    INTEGER(i4)       :: in_nproc   = 0
    INTEGER(i4)       :: in_niproc  = 0
@@ -309,5 +301,6 @@
    &  cn_coord1,   &    !< coordinate file
    &  cn_bathy1,   &    !< bathymetry file
-   &  in_perio1         !< periodicity index
+   &  in_perio1,   &    !< periodicity index
+   &  in_extrap
  
    NAMELIST /namzgr/ &
@@ -339,8 +332,7 @@
    NAMELIST /namout/ &  !< output namlist
    &  cn_fileout, &     !< fine grid bathymetry file
-   &  ln_extrap,  &     !< extrapolate or not
+   &  in_nproc,   &     !< number of processor to be used
    &  in_niproc,  &     !< i-direction number of processor
    &  in_njproc,  &     !< j-direction numebr of processor
-   &  in_nproc,   &     !< number of processor to be used
    &  cn_type           !< output type format (dimg, cdf)
    !-------------------------------------------------------------------
@@ -355,5 +347,5 @@
       CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
    ENDIF
-
+   
    ! read namelist
    INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
@@ -442,9 +434,5 @@
    ! check
    ! check output file do not already exist
-   IF( in_nproc > 0 )THEN
-      cl_fileout=file_rename(cn_fileout,1)
-   ELSE
-      cl_fileout=file_rename(cn_fileout)
-   ENDIF
+   cl_fileout=file_rename(cn_fileout,1)
    INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist)
    IF( ll_exist )THEN
@@ -480,6 +468,16 @@
    &                            il_rho(:) )
 
-   ! fine grid ghost cell
+   ! compute level
+   ALLOCATE(tl_level(ip_npoint))
+   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
+
+   ! remove ghost cell
    il_xghost(:,:)=grid_get_ghost(tl_bathy1)
+   DO ji=1,ip_npoint
+      CALL grid_del_ghost(tl_level(ji), il_xghost(:,:))
+   ENDDO
+
+   ! clean
+   CALL mpp_clean(tl_bathy1)
 
    ! work on variables
@@ -516,8 +514,5 @@
                tl_var(jvar) = create_restart_matrix( &
                &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, &
-               &  in_nlevel, il_xghost(:,:) )
-
-               ! add ghost cell
-               CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
+               &  in_nlevel, tl_level(:) )
 
             ENDDO
@@ -540,5 +535,4 @@
             ! open mpp file
             CALL iom_mpp_open(tl_mpp)
-
 
             ! get or check depth value
@@ -585,5 +579,5 @@
                DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
 
-                  WRITE(*,'(2x,a,a)') "work on (extract) variable "//&
+                  WRITE(*,'(2x,a,a)') "work on variable "//&
                   &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -606,6 +600,9 @@
                   CALL att_clean(tl_att)
 
+                  ! use mask
+                  CALL create_restart_mask(tl_var(jvar), tl_level(:))
+
                   ! add ghost cell
-                  CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:))
+                  CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:) )
 
                ENDDO
@@ -634,5 +631,5 @@
                DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
 
-                  WRITE(*,'(2x,a,a)') "work on (interp) variable "//&
+                  WRITE(*,'(2x,a,a)') "work on variable "//&
                   &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -649,7 +646,8 @@
                   &                                   id_rho=il_rho(:), &
                   &                                   cd_point=TRIM(tl_var(jvar)%c_point))
+                  
 
                   ! interpolate variable
-                  CALL create_restart_interp(tl_var(jvar), & 
+                  CALL create_restart_interp(tl_var(jvar), tl_level(:), &
                   &                          il_rho(:), &
                   &                          id_offset=il_offset(:,:))
@@ -677,6 +675,11 @@
                   CALL att_clean(tl_att)
 
+                  ! use mask
+                  CALL create_restart_mask(tl_var(jvar), tl_level(:))
+
                   ! add ghost cell
-                  CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
+                  CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) )
+
+
                ENDDO
 
@@ -702,19 +705,7 @@
    CALL mpp_clean(tl_coord0)
 
-   IF( .NOT. ln_extrap )THEN
-      ! compute level
-      ALLOCATE(tl_level(ip_npoint))
-      tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
-   ENDIF
-
-   ! clean
-   CALL mpp_clean(tl_bathy1)
-
    ! use additional request
    DO jvar=1,il_nvar
 
-      ! change unit and apply factor
-      CALL var_chg_unit(tl_var(jvar))
-
       ! forced min and max value
       CALL var_limit_value(tl_var(jvar))
@@ -723,8 +714,8 @@
       CALL filter_fill_value(tl_var(jvar))
 
-      IF( .NOT. ln_extrap )THEN
-         ! use mask
-         CALL create_restart_mask(tl_var(jvar), tl_level(:))
-      ENDIF
+      ! extrapolate
+      CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, &
+      &                                    id_jext=in_extrap, &
+      &                                    id_kext=in_extrap)
 
    ENDDO
@@ -733,5 +724,5 @@
    IF( in_niproc == 0 .AND. &
    &   in_njproc == 0 .AND. &
-   &   in_nproc == 0 )THEN
+   &   in_nproc  == 0 )THEN
       in_niproc = 1
       in_njproc = 1
@@ -791,5 +782,5 @@
          CALL mpp_add_var(tl_mppout, tl_depth)
       ELSE
-         CALL logger_warn("CREATE RESTART: no value for depth variable.")
+         CALL logger_error("CREATE RESTART: no value for depth variable.")
       ENDIF
    ENDIF
@@ -801,5 +792,5 @@
          CALL mpp_add_var(tl_mppout, tl_time)
       ELSE
-         CALL logger_warn("CREATE RESTART: no value for time variable.")
+         CALL logger_error("CREATE RESTART: no value for time variable.")
       ENDIF
    ENDIF
@@ -807,5 +798,5 @@
 
    ! add other variable
-   DO jvar=il_nvar,1,-1
+   DO jvar=1,il_nvar
       ! check if variable already add
       il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name)
@@ -816,4 +807,9 @@
    ENDDO
 
+!   DO ji=1,4
+!      CALL grid_add_ghost( tl_level(ji), il_xghost(:,:) )
+!      CALL var_clean(tl_level(ji))
+!   ENDDO
+
    ! add some attribute
    tl_att=att_init("Created_by","SIREN create_restart")
@@ -843,7 +839,4 @@
    ENDIF
 
-   ! print
-   CALL mpp_print(tl_mppout)
-
    ! create file
    CALL iom_mpp_create(tl_mppout)
@@ -854,12 +847,13 @@
    CALL iom_mpp_close(tl_mppout)
 
+   ! print
+   CALL mpp_print(tl_mppout)
+
    ! clean
    CALL att_clean(tl_att)
    CALL var_clean(tl_var(:))
    DEALLOCATE(tl_var)
-   IF( .NOT. ln_extrap )THEN
-      CALL var_clean(tl_level(:))
-      DEALLOCATE(tl_level)
-   ENDIF
+   CALL var_clean(tl_level(:))
+   DEALLOCATE(tl_level)
 
    CALL mpp_clean(tl_mppout)
@@ -882,21 +876,19 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - do not use level anymore 
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_var    variable structure 
    !> @param[in] td_coord  coordinate file structure 
    !> @param[in] id_nlevel number of vertical level  
-   !> @param[in] id_xghost ghost cell array
+   !> @param[in] td_level  array of level on T,U,V,F point (variable structure) 
    !> @return variable structure 
    !-------------------------------------------------------------------
-   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost)
+   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level)
       IMPLICIT NONE
       ! Argument
-      TYPE(TVAR)                 , INTENT(IN) :: td_var
-      TYPE(TMPP)                 , INTENT(IN) :: td_coord
-      INTEGER(i4)                , INTENT(IN) :: id_nlevel
-      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_xghost
+      TYPE(TVAR)              , INTENT(IN) :: td_var
+      TYPE(TMPP)              , INTENT(IN) :: td_coord
+      INTEGER(i4)             , INTENT(IN) :: id_nlevel
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level
 
       ! function
@@ -907,4 +899,5 @@
       INTEGER(i4)      , DIMENSION(3)                    :: il_size
       INTEGER(i4)      , DIMENSION(3)                    :: il_rest
+      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost
 
       INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
@@ -922,4 +915,7 @@
       !----------------------------------------------------------------
 
+      ! look for ghost cell
+      il_xghost(:,:)=grid_get_ghost( td_coord )
+
       ! write value on grid
       ! get matrix dimension
@@ -933,6 +929,6 @@
 
       ! remove ghost cell
-      tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(id_xghost(jp_I,:))*ip_ghost
-      tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(id_xghost(jp_J,:))*ip_ghost
+      tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(il_xghost(jp_I,:))*ip_ghost
+      tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(il_xghost(jp_J,:))*ip_ghost
 
       ! split output domain in N subdomain depending of matrix dimension 
@@ -996,4 +992,10 @@
       DEALLOCATE(dl_value)
 
+      ! use mask
+      CALL create_restart_mask(create_restart_matrix, td_level(:))
+
+      ! add ghost cell
+      CALL grid_add_ghost( create_restart_matrix, il_xghost(:,:) )
+
       ! clean 
       DEALLOCATE(il_ishape)
@@ -1007,5 +1009,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -1069,9 +1071,8 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - do not use level anymore (for extrapolation)
+   !> - Nov, 2013- Initial Version
    !>
    !> @param[inout] td_var    variable structure 
+   !> @param[inout] td_level  fine grid level, array of variable structure
    !> @param[in] id_rho       array of refinment factor
    !> @param[in] id_offset    array of offset between fine and coarse grid
@@ -1079,5 +1080,5 @@
    !> @param[in] id_jext      j-direction size of extra bands (default=im_minext)
    !-------------------------------------------------------------------
-   SUBROUTINE create_restart_interp( td_var, & 
+   SUBROUTINE create_restart_interp( td_var, td_level,&
    &                                 id_rho,          &
    &                                 id_offset,       &
@@ -1088,4 +1089,5 @@
       ! Argument
       TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      TYPE(TVAR) , DIMENSION(:)  , INTENT(INOUT) :: td_level
       INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
       INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
@@ -1117,4 +1119,5 @@
          il_jext=2
       ENDIF
+
       ! work on variable
       ! add extraband
@@ -1122,5 +1125,8 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var )
+      CALL extrap_fill_value( td_var, td_level(:),    &
+      &                               id_offset(:,:), &
+      &                               id_rho(:),      &
+      &                               id_iext=il_iext, id_jext=il_jext )
 
       ! interpolate variable
@@ -1140,5 +1146,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2014 - Initial Version
+   !> - November, 2014- Initial Version
    !>
    !> @param[in] td_mpp       mpp structure
@@ -1191,5 +1197,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2014 - Initial Version
+   !> - November, 2014- Initial Version
    !>
    !> @param[in] td_mpp      mpp structure
@@ -1214,5 +1220,4 @@
 
       ! get or check depth value
-
       IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 10251)
@@ -78,5 +78,5 @@
 !>
 !>    This subroutine filled dimension structure with unused dimension, 
-!>    then switch from "disordered" dimension to "ordered" dimension.<br/>
+!>    then switch from "unordered" dimension to "ordered" dimension.<br/>
 !>    The dimension structure return will be:<br/>
 !>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/>
@@ -94,8 +94,8 @@
 !>    - cl_neworder : character(len=4) (example: 'yxzt')
 !>
-!>    to switch dimension array from ordered dimension to disordered
+!>    to switch dimension array from ordered dimension to unordered
 !> dimension:<br/>
 !> @code
-!>    CALL dim_disorder(tl_dim(:))
+!>    CALL dim_unorder(tl_dim(:))
 !> @endcode
 !>
@@ -111,7 +111,7 @@
 !>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
 !> @endcode
-!>       - value must be a 4D array of real(8) value "disordered"
-!>
-!>    to reshape array of value in "disordered" dimension:<br/>
+!>       - value must be a 4D array of real(8) value "unordered"
+!>
+!>    to reshape array of value in "unordered" dimension:<br/>
 !> @code
 !>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
@@ -123,10 +123,10 @@
 !>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
 !> @endcode
-!>       - tab must be a 1D array with 4 elements "disordered".
+!>       - tab must be a 1D array with 4 elements "unordered".
 !>       It could be composed of character, integer(4), or logical
 !> 
-!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
-!> @code
-!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
+!>    to reorder a 1D array of 4 elements in "unordered" dimension:<br/>
+!> @code
+!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
 !> @endcode
 !>       - tab must be a 1D array with 4 elements "ordered".
@@ -173,6 +173,6 @@
    PUBLIC :: dim_print         !< print dimension information
    PUBLIC :: dim_copy          !< copy dimension structure
-   PUBLIC :: dim_reorder       !< filled dimension structure to switch from disordered to ordered dimension
-   PUBLIC :: dim_disorder      !< switch dimension array from ordered to disordered dimension
+   PUBLIC :: dim_reorder       !< filled dimension structure to switch from unordered to ordered dimension
+   PUBLIC :: dim_unorder       !< switch dimension array from ordered to unordered dimension
    PUBLIC :: dim_fill_unused   !< filled dimension structure with unused dimension 
    PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t')
@@ -321,6 +321,5 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 
-   !> - do not check if dimension used
+   !> @date September, 2014 - do not check if dimension used
    !>
    !> @param[in] td_dim    array of dimension structure
@@ -503,14 +502,8 @@
    !> Optionally length could be inform, as well as short name and if dimension
    !> is unlimited or not.<br/>
-   !> By default, define dimension is supposed to be used.
-   !> Optionally you could force a defined dimension to be unused. 
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 
-   !> - add optional argument to define dimension unused
-   !> @date July, 2015
-   !> - Bug fix: inform order to disorder table instead of disorder to order
-   !> table
+   !> define dimension is supposed to be used.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   dimension name
@@ -518,8 +511,7 @@
    !> @param[in] ld_uld    dimension unlimited
    !> @param[in] cd_sname  dimension short name
-   !> @param[in] ld_uld    dimension use or not
    !> @return dimension structure
    !-------------------------------------------------------------------
-   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use)
+   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname)
       IMPLICIT NONE
 
@@ -529,5 +521,4 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld
       CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
-      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
 
       ! local variable
@@ -552,9 +543,5 @@
 
       ! define dimension is supposed to be used
-      IF( PRESENT(ld_use) )THEN
-         dim_init%l_use=ld_use
-      ELSE
-         dim_init%l_use=.TRUE.
-      ENDIF
+      dim_init%l_use=.TRUE.
 
       IF( PRESENT(cd_sname) )THEN
@@ -603,6 +590,6 @@
       ENDIF
       
-      ! get dimension order indices
-      dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
+      ! get dimension orderer index
+      dim_init%i_2xyzt=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
 
    END FUNCTION dim_init
@@ -668,6 +655,4 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - Bug fix: use order to disorder table (see dim_init)
    !>
    !> @param[in] td_dim array of dimension structure
@@ -701,6 +686,6 @@
          ! search missing dimension
          IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
-            ! search first empty dimension (see dim_init)
-            il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 )
+            ! search first empty dimension
+            il_ind(:)=MINLOC( tl_dim(:)%i_2xyzt, tl_dim(:)%i_2xyzt == 0 )
 
             ! put missing dimension instead of empty one
@@ -708,5 +693,5 @@
             ! update output structure
             tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji))
-            tl_dim(il_ind(1))%i_xyzt2=ji
+            tl_dim(il_ind(1))%i_2xyzt=ji
             tl_dim(il_ind(1))%i_len=1
             tl_dim(il_ind(1))%l_use=.FALSE.
@@ -726,5 +711,5 @@
    !> This subroutine switch element of an array (4 elts) of dimension 
    !> structure 
-   !> from disordered dimension to ordered dimension <br/>
+   !> from unordered dimension to ordered dimension <br/>
    !>
    !> @details
@@ -737,6 +722,5 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 
-   !> - allow to choose ordered dimension to be output
+   !> @date September, 2014 - allow to choose ordered dimension to be output
    !>
    !> @param[inout] td_dim    array of dimension structure
@@ -827,5 +811,5 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
-   !> to disordered dimension. <br/>
+   !> to unordered dimension. <br/>
    !> @details
    !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
@@ -838,5 +822,5 @@
    !> @param[inout] td_dim array of dimension structure
    !-------------------------------------------------------------------
-   SUBROUTINE dim_disorder(td_dim)
+   SUBROUTINE dim_unorder(td_dim)
       IMPLICIT NONE
       ! Argument      
@@ -851,5 +835,5 @@
 
       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
+         CALL logger_error("DIM UNORDER: invalid dimension of array dimension.")
       ELSE      
          ! add dummy xyzt2 id to unused dimension
@@ -884,5 +868,5 @@
       ENDIF
 
-   END SUBROUTINE dim_disorder
+   END SUBROUTINE dim_unorder
    !-------------------------------------------------------------------
    !> @brief This function reshape real(8) 4D array   
@@ -924,6 +908,5 @@
 
       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//&
-            &  "array dimension.")
+         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of array dimension.")
       ELSE      
 
@@ -931,6 +914,6 @@
 
             CALL logger_fatal( &
-            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// &
-            &  "   before running RESHAPE" )
+            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder &
+            &     before running RESHAPE" )
 
          ENDIF
@@ -989,5 +972,5 @@
    !-------------------------------------------------------------------
    !> @brief This function reshape ordered real(8) 4D array with dimension 
-   !> (/'x','y','z','t'/) to an "disordered" array.<br/>
+   !> (/'x','y','z','t'/) to an "unordered" array.<br/>
    !> @details
    !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
@@ -1026,6 +1009,5 @@
 
       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//&
-            &  "array dimension.")
+         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of array dimension.")
       ELSE
 
@@ -1033,6 +1015,6 @@
 
             CALL logger_fatal( &
-            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// &
-            &  "   before running RESHAPE" )
+            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder &
+            &     before running RESHAPE" )
 
          ENDIF        
@@ -1122,6 +1104,6 @@
 
             CALL logger_error( &
-            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
-            &  "   before running REORDER" )
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder &
+            &     before running REORDER" )
 
          ENDIF        
@@ -1134,5 +1116,5 @@
    END FUNCTION dim__reorder_2xyzt_i4
    !-------------------------------------------------------------------
-   !> @brief This function disordered integer(4) 1D array to be suitable with
+   !> @brief This function unordered integer(4) 1D array to be suitable with
    !> initial dimension order (ex: dimension read in file).
    !> @note you must have run dim_reorder before use this subroutine
@@ -1161,12 +1143,12 @@
       IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
       &   SIZE(id_arr(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//&
-            &  "array dimension or of array of value.")
+         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
+         &              " or of array of value.")
       ELSE      
          IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
 
             CALL logger_error( &
-            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
-            &  "   before running REORDER" )
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder &
+            &     before running REORDER" )
 
          ENDIF        
@@ -1184,5 +1166,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> @date Nov, 2013 - Initial Version
    !
    !> @param[in] td_dim array of dimension structure
@@ -1211,6 +1193,6 @@
 
             CALL logger_error( &
-            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// &
-            &  "   before running REORDER" )
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder &
+            &     before running REORDER" )
 
          ENDIF        
@@ -1223,5 +1205,5 @@
    END FUNCTION dim__reorder_2xyzt_l
    !-------------------------------------------------------------------
-   !> @brief This function disordered logical 1D array to be suitable with
+   !> @brief This function unordered logical 1D array to be suitable with
    !> initial dimension order (ex: dimension read in file).
    !> @note you must have run dim_reorder before use this subroutine
@@ -1256,6 +1238,6 @@
 
             CALL logger_error( &
-            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//&
-            &  "  before running REORDER" )
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder &
+            &     before running REORDER" )
 
          ENDIF        
@@ -1312,10 +1294,10 @@
    END FUNCTION dim__reorder_2xyzt_c
    !-------------------------------------------------------------------
-   !> @brief This function disordered string 1D array to be suitable with
+   !> @brief This function unordered string 1D array to be suitable with
    !> initial dimension order (ex: dimension read in file).
    !> @note you must have run dim_reorder before use this subroutine
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> @date Nov, 2013 - Initial Version
    !
    !> @param[in] td_dim array of dimension structure
@@ -1344,6 +1326,6 @@
          IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
             CALL logger_error( &
-            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
-            &  "   before running REORDER" )
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder &
+            &     before running REORDER" )
 
          ENDIF        
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 10251)
@@ -13,6 +13,6 @@
 # Fortran Compiler
    SIREN codes were succesfully tested with :
-   - ifort (version 15.0.1)
-   - gfortran (version 4.8.2 20140120) 
+   - ifort (version 12.0.4)
+   - gfortran (version 4.7.2 20121109)
 <!--   - pgf95 (version 13.9-0) -->
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md	(revision 10251)
@@ -80,5 +80,5 @@
 
 # Implicit none {#implicit}
-All subroutines and functions will include an IMPLICIT NONE statement.
+All subroutines and functions will include an IMPLICTI NONE statement.
 
 # Header {#header}
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/domain.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 10251)
@@ -246,5 +246,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - Nov, 2013- Initial Version
    !
    !> @param[inout] td_dom dom structure
@@ -294,5 +294,5 @@
    !
    !> @author J.Paul
-   !> @date June, 2013 - Initial Version
+   !> - June, 2013- Initial Version
    !> @date September, 2014
    !> - add boundary index
@@ -362,7 +362,6 @@
 
          IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN
-            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
-            &  TRIM(fct_str(td_mpp%i_perio))//&
-            &  ") you should use grid_get_perio to compute it")
+            CALL logger_error("DOM INIT: invalid grid periodicity. "//&
+            &  "you should use grid_get_perio to compute it")
          ELSE
             dom__init_mpp%i_perio0=td_mpp%i_perio
@@ -425,5 +424,5 @@
    !
    !> @author J.Paul
-   !> @date June, 2013 - Initial Version
+   !> - June, 2013- Initial Version
    !> @date September, 2014
    !> - add boundary index
@@ -490,7 +489,6 @@
 
          IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN
-            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
-            &  TRIM(fct_str(td_file%i_perio))//&
-            &  ") you should use grid_get_perio to compute it")
+            CALL logger_error("DOM INIT: invalid grid periodicity. "//&
+            &  "you should use grid_get_perio to compute it")
          ELSE
             dom__init_file%i_perio0=td_file%i_perio
@@ -550,5 +548,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain structure
@@ -655,5 +653,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !> @date September, 2014
    !> - use zero indice to defined cyclic or global domain
@@ -723,5 +721,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial verison
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -757,5 +755,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -776,5 +774,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -808,5 +806,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -826,5 +824,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -864,5 +862,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -914,5 +912,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -953,5 +951,5 @@
    !>
    !> @author J.Paul
-   !> @date April, 2013 - Initial version
+   !> - April, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -981,5 +979,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -1043,5 +1041,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -1084,5 +1082,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -1182,5 +1180,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !
    !> @param[inout] td_dom domain strcuture
@@ -1294,5 +1292,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date November, 2013
    !> @date September, 2014
    !> - take into account number of ghost cell
@@ -1435,5 +1433,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date November, 2013
    !
    !> @param[inout] td_dom domain strcuture
@@ -1478,5 +1476,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date November, 2013
    !> @date September, 2014
    !> - take into account boundary for one point size domain
@@ -1717,5 +1715,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date November, 2013
    !
    !> @param[inout] td_dom domain strcuture
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/extrap.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 10251)
@@ -19,19 +19,30 @@
 !>    defining string character _cn\_varinfo_. By default _dist_weight_.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:ext=dist_weight', 'varname2:ext=min_error'
+!>       - cn_varinfo='varname1:dist_weight', 'varname2:min_error'
 !>
 !>    to detect point to be extrapolated:<br/>
 !> @code
-!>    il_detect(:,:,:)=extrap_detect(td_var)
+!>    il_detect(:,:,:)=extrap_detect(td_var, [td_level], [id_offset,] [id_rho,] [id_ext]) 
 !> @endcode
 !>       - il_detect(:,:,:) is 3D array of point to be extrapolated
 !>       - td_var  is coarse grid variable to be extrapolated
+!>       - td_level is fine grid array of level (see vgrid_get_level) [optional]
+!>       - id_offset is array of offset between fine and coarse grid [optional]
+!>       - id_rho    is array of refinment factor [optional]
+!>       - id_ext    is array of number of points to be extrapolated [optional]
 !>
 !>    to extrapolate variable:<br/>
 !> @code
-!>    CALL extrap_fill_value( td_var, [id_radius])
+!>    CALL extrap_fill_value( td_var, [td_level], [id_offset], [id_rho], [id_iext], [id_jext], [id_kext], [id_radius], [id_maxiter])
 !> @endcode
 !>       - td_var  is coarse grid variable to be extrapolated
+!>       - td_level is fine grid array of level (see vgrid_get_level) [optional]
+!>       - id_offset is array of offset between fine and coarse grid [optional]
+!>       - id_rho    is array of refinment factor [optional]
+!>       - id_iext   is number of points to be extrapolated in i-direction [optional]
+!>       - id_jext   is number of points to be extrapolated in j-direction [optional]
+!>       - id_kext   is number of points to be extrapolated in k-direction [optional]
 !>       - id_radius is radius of the halo used to compute extrapolation [optional]
+!>       - id_maxiter is maximum number of iteration [optional]
 !>
 !>    to add extraband to the variable (to be extrapolated):<br/>
@@ -51,4 +62,30 @@
 !>       - id_jsize : j-direction size of extra bands [optional]
 !>
+!>    to compute first derivative of 1D array:<br/>
+!> @code
+!>    dl_value(:)=extrap_deriv_1D( dd_value(:), dd_fill, [ld_discont] )
+!> @endcode
+!>       - dd_value is 1D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional]
+!>
+!>    to compute first derivative of 2D array:<br/>
+!> @code
+!>    dl_value(:,:)=extrap_deriv_2D( dd_value(:,:), dd_fill, cd_dim, [ld_discont] )
+!> @endcode
+!>       - dd_value is 2D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - cd_dim is character to compute derivative on first (I) or second (J) dimension
+!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional]
+!>
+!>    to compute first derivative of 3D array:<br/>
+!> @code
+!>    dl_value(:,:,:)=extrap_deriv_3D( dd_value(:,:,:), dd_fill, cd_dim, [ld_discont] )
+!> @endcode
+!>       - dd_value is 3D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - cd_dim is character to compute derivative on first (I), second (J), or third (K) dimension
+!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional]
+!>
 !> @warning _FillValue must not be zero (use var_chg_FillValue())
 !>
@@ -56,17 +93,10 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date November, 2013 - Initial Version
+!> @date Nov, 2013 - Initial Version
 !> @date September, 2014
 !> - add header
-!> @date June, 2015
-!> - extrapolate all land points (_FillValue)
-!> - move deriv function to math module
-!> @date July, 2015
-!> - compute extrapolation from north west to south east, 
-!> and from south east to north west
 !>
 !> @todo
 !> - create module for each extrapolation method
-!> - smooth extrapolated points
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -80,5 +110,4 @@
    USE date                            ! date manager
    USE logger                          ! log file manager
-   USE math                            ! mathematical function
    USE att                             ! attribute manager
    USE dim                             ! dimension manager
@@ -89,4 +118,5 @@
 
    ! type and variable
+   PRIVATE :: im_maxiter   !< default maximum number of iteration 
    PRIVATE :: im_minext    !< default minumum number of point to extrapolate
    PRIVATE :: im_mincubic  !< default minumum number of point to extrapolate for cubic interpolation
@@ -97,4 +127,7 @@
    PUBLIC :: extrap_add_extrabands !< add extraband to the variable (to be extrapolated) 
    PUBLIC :: extrap_del_extrabands !< delete extraband of the variable 
+   PUBLIC :: extrap_deriv_1D       !< compute first derivative of 1D array 
+   PUBLIC :: extrap_deriv_2D       !< compute first derivative of 2D array 
+   PUBLIC :: extrap_deriv_3D       !< compute first derivative of 3D array
 
    PRIVATE :: extrap__detect_wrapper      ! detected point to be extrapolated wrapper
@@ -108,4 +141,5 @@
    PRIVATE :: extrap__3D_dist_weight_fill ! 
 
+   INTEGER(i4), PARAMETER :: im_maxiter = 10 !< default maximum number of iteration
    INTEGER(i4), PARAMETER :: im_minext  = 2  !< default minumum number of point to extrapolate
    INTEGER(i4), PARAMETER :: im_mincubic= 4  !< default minumum number of point to extrapolate for cubic interpolation
@@ -137,15 +171,22 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - do not use level to select points to be extrapolated
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var0   coarse grid variable to extrapolate
+   !> @param[in] td_level1 fine grid array of level
+   !> @param[in] id_offset array of offset between fine and coarse grid 
+   !> @param[in] id_rho    array of refinment factor 
+   !> @param[in] id_ext    array of number of points to be extrapolated
    !> @return array of point to be extrapolated
    !-------------------------------------------------------------------
-   FUNCTION extrap__detect( td_var0 ) 
+   FUNCTION extrap__detect( td_var0, td_level1, &
+   &                        id_offset, id_rho, id_ext )
       IMPLICIT NONE
       ! Argument
       TYPE(TVAR) ,                 INTENT(IN   ) :: td_var0
+      TYPE(TVAR) , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level1
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_ext
 
       ! function
@@ -155,12 +196,180 @@
 
       ! local variable
+      CHARACTER(LEN=lc)                                :: cl_level
+
+      INTEGER(i4)                                      :: il_ind
+      INTEGER(i4)      , DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+      INTEGER(i4)      , DIMENSION(:,:,:), ALLOCATABLE :: il_tmp
+      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_offset
+      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_level1
+      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_level1_G0
+      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_extra
+      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_ext
+      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_rho
+      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_dim0
+
+      TYPE(TVAR)                                       :: tl_var1
+
       ! loop indices
       INTEGER(i4) :: ji0
       INTEGER(i4) :: jj0
       INTEGER(i4) :: jk0
+      INTEGER(i4) :: ji1
+      INTEGER(i4) :: jj1
+      INTEGER(i4) :: ji1m
+      INTEGER(i4) :: jj1m
+      INTEGER(i4) :: ji1p
+      INTEGER(i4) :: jj1p
       !----------------------------------------------------------------
 
-      ! force to extrapolated all points
-      extrap__detect(:,:,:)=1
+      ! init
+      extrap__detect(:,:,:)=0
+
+      ALLOCATE( il_dim0(3) )
+      il_dim0(:)=td_var0%t_dim(1:3)%i_len
+
+      ! optional argument
+      ALLOCATE( il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:)
+
+      ALLOCATE( il_offset(ip_maxdim,2) )
+      il_offset(:,:)=0
+      IF( PRESENT(id_offset) )THEN
+         il_offset(1:SIZE(id_offset(:,:),DIM=1),&
+         &         1:SIZE(id_offset(:,:),DIM=2) )= id_offset(:,:)
+      ELSE
+         il_offset(jp_I,:)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5)
+         il_offset(jp_J,:)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5)
+      ENDIF
+
+      ALLOCATE( il_ext(ip_maxdim) )
+      il_ext(:)=im_minext
+      IF( PRESENT(id_ext) ) il_ext(1:SIZE(id_ext(:)))=id_ext(:)
+
+      ALLOCATE( il_detect(il_dim0(1),&
+      &                   il_dim0(2),&
+      &                   il_dim0(3)) )
+      il_detect(:,:,:)=0
+
+      ! select point already inform
+      DO jk0=1,td_var0%t_dim(3)%i_len
+         DO jj0=1,td_var0%t_dim(2)%i_len
+            DO ji0=1,td_var0%t_dim(1)%i_len
+               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill ) il_detect(ji0,jj0,jk0)=1
+            ENDDO
+         ENDDO
+      ENDDO
+ 
+      IF( PRESENT(td_level1) )THEN
+         SELECT CASE(TRIM(td_var0%c_point))
+            CASE DEFAULT !'T'
+               cl_level='tlevel'
+            CASE('U')
+               cl_level='ulevel'
+            CASE('V')
+               cl_level='vlevel'
+            CASE('F')
+               cl_level='flevel'
+         END SELECT
+
+         il_ind=var_get_index(td_level1(:),TRIM(cl_level))
+         IF( il_ind == 0 )THEN
+            CALL logger_error("EXTRAP DETECT: can not compute point to be "//&
+            &     "extrapolated for variable "//TRIM(td_var0%c_name)//&
+            &      ". can not find "//&
+            &     "level for variable point "//TRIM(TRIM(td_var0%c_point)))
+         ELSE
+            tl_var1=var_copy(td_level1(il_ind))
+
+            ALLOCATE( il_level1_G0( il_dim0(1), il_dim0(2)) )
+            IF( ALL(tl_var1%t_dim(1:2)%i_len == il_dim0(1:2)) )THEN
+
+               ! variable to be extrapolated use same resolution than level
+               il_level1_G0(:,:)=INT(tl_var1%d_value(:,:,1,1),i4)
+               
+            ELSE
+               ! variable to be extrapolated do not use same resolution than level
+               ALLOCATE( il_level1(tl_var1%t_dim(1)%i_len, &
+               &                   tl_var1%t_dim(2)%i_len) )
+               ! match fine grid vertical level with coarse grid
+               il_level1(:,:)=INT(tl_var1%d_value(:,:,1,1),i4)/il_rho(jp_K)
+
+               ALLOCATE( il_extra(ip_maxdim,2) )
+               ! coarsening fine grid level
+               il_extra(jp_I,1)=CEILING(REAL(il_rho(jp_I)-1,dp)*0.5_dp)
+               il_extra(jp_I,2)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5_dp)
+
+               il_extra(jp_J,1)=CEILING(REAL(il_rho(jp_J)-1,dp)*0.5_dp)
+               il_extra(jp_J,2)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5_dp)
+
+               DO jj0=1,td_var0%t_dim(2)%i_len
+                  
+                  jj1=(jj0-1)*il_rho(jp_J)+1-il_offset(jp_J,1)
+
+                  jj1m=MAX( jj1-il_extra(jp_J,1), 1 )
+                  jj1p=MIN( jj1+il_extra(jp_J,2), &
+                  &         tl_var1%t_dim(2)%i_len-il_offset(jp_J,2) )
+                  
+                  DO ji0=1,td_var0%t_dim(1)%i_len
+
+                     ji1=(ji0-1)*il_rho(jp_I)+1-id_offset(jp_I,1)
+
+                     ji1m=MAX( ji1-il_extra(jp_I,1), 1 )
+                     ji1p=MIN( ji1+il_extra(jp_I,2), &
+                     &         tl_var1%t_dim(1)%i_len-id_offset(jp_I,2) )
+               
+                     il_level1_G0(ji0,jj0)=MAXVAL(il_level1(ji1m:ji1p,jj1m:jj1p))
+
+                  ENDDO
+               ENDDO
+
+               ! clean
+               DEALLOCATE( il_extra )
+               DEALLOCATE( il_level1 )
+
+            ENDIF
+
+            ! look for sea point
+            DO jk0=1,td_var0%t_dim(3)%i_len
+               WHERE( il_level1_G0(:,:) >= jk0)
+                  il_detect(:,:,jk0)=1
+               END WHERE
+            ENDDO
+
+            ! clean
+            DEALLOCATE( il_level1_G0 )
+            CALL var_clean(tl_var1)
+
+         ENDIF
+      ENDIF
+
+      ! clean
+      DEALLOCATE( il_offset )
+ 
+      ALLOCATE( il_tmp(il_dim0(1),&
+      &                il_dim0(2),&
+      &                il_dim0(3)) )
+      il_tmp(:,:,:)=il_detect(:,:,:)
+      ! select extra point depending on interpolation method
+      ! compute point near grid point already inform
+      DO jk0=1,il_dim0(3)
+         DO jj0=1,il_dim0(2)
+            DO ji0=1,il_dim0(1)
+
+               IF( il_tmp(ji0,jj0,jk0) == 1 )THEN
+                  il_detect( &
+                  &  MAX(1,ji0-il_ext(jp_I)):MIN(ji0+il_ext(jp_I),il_dim0(1)),&
+                  &  MAX(1,jj0-il_ext(jp_J)):MIN(jj0+il_ext(jp_J),il_dim0(2)),&
+                  &  MAX(1,jk0-il_ext(jp_K)):MIN(jk0+il_ext(jp_K),il_dim0(3)) &
+                  &  ) = 1 
+               ENDIF
+
+            ENDDO
+         ENDDO
+      ENDDO
+      
+      ! clean
+      DEALLOCATE( il_tmp )
 
       ! do not compute grid point already inform
@@ -168,10 +377,17 @@
          DO jj0=1,td_var0%t_dim(2)%i_len
             DO ji0=1,td_var0%t_dim(1)%i_len
-               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill )THEN
-                  extrap__detect(ji0,jj0,jk0)=0
-               ENDIF
+               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill ) il_detect(ji0,jj0,jk0)=0
             ENDDO
          ENDDO
       ENDDO
+
+      ! save result
+      extrap__detect(:,:,:)=il_detect(:,:,:)
+
+      ! clean
+      DEALLOCATE( il_dim0 )
+      DEALLOCATE( il_ext )
+      DEALLOCATE( il_detect )
+      DEALLOCATE( il_rho )
 
    END FUNCTION extrap__detect
@@ -182,16 +398,23 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - select all land points for extrapolation
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_var    coarse grid variable to extrapolate
+   !> @param[in] td_level  fine grid array of level
+   !> @param[in] id_offset array of offset between fine and coarse grid 
+   !> @param[in] id_rho    array of refinment factor 
+   !> @param[in] id_ext    array of number of points to be extrapolated
    !> @return 3D array of point to be extrapolated
    !-------------------------------------------------------------------
-   FUNCTION extrap__detect_wrapper( td_var )
+   FUNCTION extrap__detect_wrapper( td_var, td_level, &
+   &                                id_offset, id_rho, id_ext )
 
       IMPLICIT NONE
       ! Argument
       TYPE(TVAR) ,                 INTENT(IN   ) :: td_var
+      TYPE(TVAR) , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_ext
 
       ! function
@@ -216,5 +439,8 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var )
+         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var, td_level, &
+         &                                             id_offset, &
+         &                                             id_rho,    &
+         &                                             id_ext     )
 
       ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
@@ -224,5 +450,8 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var )
+         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var , td_level,&
+         &                                               id_offset, &
+         &                                               id_rho,    &
+         &                                               id_ext     )
 
       ELSE IF( td_var%t_dim(3)%l_use )THEN
@@ -232,5 +461,8 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var )
+         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var , td_level, &
+         &                                                 id_offset, &
+         &                                                 id_rho,    &
+         &                                                 id_ext     )
 
       ENDIF              
@@ -257,20 +489,39 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - select all land points for extrapolation
+   !> - Nov, 2013- Initial Version
    !
    !> @param[inout] td_var    variable structure
+   !> @param[in] td_level     fine grid array of level
+   !> @param[in] id_offset    array of offset between fine and coarse grid 
+   !> @param[in] id_rho       array of refinment factor 
+   !> @param[in] id_iext      number of points to be extrapolated in i-direction
+   !> @param[in] id_jext      number of points to be extrapolated in j-direction
+   !> @param[in] id_kext      number of points to be extrapolated in k-direction
    !> @param[in] id_radius    radius of the halo used to compute extrapolation 
-   !-------------------------------------------------------------------
-   SUBROUTINE extrap__fill_value_wrapper( td_var, & 
-   &                                      id_radius )
+   !> @param[in] id_maxiter   maximum number of iteration
+   !-------------------------------------------------------------------
+   SUBROUTINE extrap__fill_value_wrapper( td_var, td_level, &
+   &                                      id_offset,        &
+   &                                      id_rho,           &
+   &                                      id_iext, id_jext, id_kext, &
+   &                                      id_radius, id_maxiter )
       IMPLICIT NONE
       ! Argument
       TYPE(TVAR) ,                  INTENT(INOUT) :: td_var
+      TYPE(TVAR) ,  DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level
+      INTEGER(i4),  DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
+      INTEGER(i4),  DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
+      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_jext
+      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_kext
       INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_radius
+      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_maxiter
 
       ! local variable
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+      INTEGER(i4) :: il_kext
       INTEGER(i4) :: il_radius
+      INTEGER(i4) :: il_maxiter
 
       CHARACTER(LEN=lc) :: cl_method
@@ -293,18 +544,66 @@
          END SELECT
 
-         ! number of point use to compute box
-         il_radius=1
-         IF( PRESENT(id_radius) ) il_radius=id_radius
-         IF( il_radius < 0 )THEN
+         il_iext=im_minext
+         IF( PRESENT(id_iext) ) il_iext=id_iext
+         il_jext=im_minext
+         IF( PRESENT(id_jext) ) il_jext=id_jext
+         il_kext=0
+         IF( PRESENT(id_kext) ) il_kext=id_kext
+
+         IF( TRIM(td_var%c_interp(1)) == 'cubic')THEN
+            IF( il_iext > 0 .AND. il_iext < im_mincubic ) il_iext=im_mincubic
+            IF( il_jext > 0 .AND. il_jext < im_mincubic ) il_jext=im_mincubic
+         ENDIF
+
+         IF( il_iext < 0 )THEN
             CALL logger_error("EXTRAP FILL VALUE: invalid "//&
-            &  " radius of the box used to compute extrapolation "//&
-            &  "("//TRIM(fct_str(il_radius))//")")
+            &  " number of points to be extrapolated in i-direction "//&
+            &  "("//TRIM(fct_str(il_iext))//")")
          ENDIF
 
-         CALL logger_info("EXTRAP FILL: extrapolate "//TRIM(td_var%c_name)//&
-         &  " using "//TRIM(cl_method)//" method." )
-
-         CALL extrap__fill_value( td_var, cl_method, &
-         &                        il_radius )
+         IF( il_jext < 0 )THEN
+            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
+            &  " number of points to be extrapolated in j-direction "//&
+            &  "("//TRIM(fct_str(il_jext))//")")
+         ENDIF
+
+         IF( il_kext < 0 )THEN
+            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
+            &  " number of points to be extrapolated in k-direction "//&
+            &  "("//TRIM(fct_str(il_kext))//")")
+         ENDIF
+
+         IF( (il_iext /= 0 .AND. td_var%t_dim(1)%l_use) .OR. &
+         &   (il_jext /= 0 .AND. td_var%t_dim(2)%l_use) .OR. &
+         &   (il_kext /= 0 .AND. td_var%t_dim(3)%l_use) )THEN
+
+            ! number of point use to compute box
+            il_radius=1
+            IF( PRESENT(id_radius) ) il_radius=id_radius
+            IF( il_radius < 0 )THEN
+               CALL logger_error("EXTRAP FILL VALUE: invalid "//&
+               &  " radius of the box used to compute extrapolation "//&
+               &  "("//TRIM(fct_str(il_radius))//")")
+            ENDIF
+
+            ! maximum number of iteration
+            il_maxiter=im_maxiter
+            IF( PRESENT(id_maxiter) ) il_maxiter=id_maxiter
+            IF( il_maxiter < 0 )THEN
+               CALL logger_error("EXTRAP FILL VALUE: invalid "//&
+               &  " maximum nuber of iteration "//&
+               &  "("//TRIM(fct_str(il_maxiter))//")")
+            ENDIF
+
+            CALL logger_info("EXTRAP FILL: extrapolate "//TRIM(td_var%c_name)//&
+            &  " using "//TRIM(cl_method)//" method." )
+
+            CALL extrap__fill_value( td_var, cl_method, &
+            &                        il_iext, il_jext, il_kext,   &
+            &                        il_radius, il_maxiter,       &
+            &                        td_level,                    &
+            &                        id_offset, id_rho )
+ 
+         ENDIF
  
       ENDIF
@@ -322,19 +621,35 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - select all land points for extrapolation
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var    variable structure
    !> @param[in] cd_method    extrapolation method
+   !> @param[in] id_iext      number of points to be extrapolated in i-direction
+   !> @param[in] id_jext      number of points to be extrapolated in j-direction
+   !> @param[in] id_kext      number of points to be extrapolated in k-direction
    !> @param[in] id_radius    radius of the halo used to compute extrapolation
+   !> @param[in] id_maxiter   maximum number of iteration
+   !> @param[in] td_level     fine grid array of level
+   !> @param[in] id_offset    array of offset between fine and coarse grid 
+   !> @param[in] id_rho       array of refinment factor
    !-------------------------------------------------------------------
    SUBROUTINE extrap__fill_value( td_var, cd_method, &
-   &                              id_radius )
+   &                              id_iext, id_jext, id_kext, &
+   &                              id_radius, id_maxiter, &
+   &                              td_level,          &
+   &                              id_offset,         &
+   &                              id_rho )
       IMPLICIT NONE
       ! Argument
       TYPE(TVAR)      ,                 INTENT(INOUT) :: td_var
       CHARACTER(LEN=*),                 INTENT(IN   ) :: cd_method
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_iext
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_jext
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_kext
       INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_maxiter
+      TYPE(TVAR)      , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level
+      INTEGER(i4)     , DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
 
       ! local variable
@@ -353,6 +668,8 @@
       &                    td_var%t_dim(3)%i_len) )
 
-      il_detect(:,:,:) = extrap_detect( td_var )
-
+      il_detect(:,:,:) = extrap_detect( td_var, td_level, &
+      &                                 id_offset,        &
+      &                                 id_rho,           &
+      &                                 id_ext=(/id_iext, id_jext, id_kext/) )
       !2- add attribute to variable
       cl_extrap=fct_concat(td_var%c_extrap(:))
@@ -362,21 +679,12 @@
       CALL att_clean(tl_att)
 
-      IF( ALL(il_detect(:,:,:)==1) )THEN
-         CALL logger_warn(" EXTRAP FILL: "//&
-            &  " can not extrapolate "//TRIM(td_var%c_name)//&
-            &  ". no value inform." )
-      ELSE
-         CALL logger_info(" EXTRAP FILL: "//&
-            &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
-            &              " point(s) to extrapolate " )
-
-         CALL logger_info(" EXTRAP FILL: method "//&
-            &  TRIM(cd_method) )
-
-         !3- extrapolate
-         CALL extrap__3D(td_var%d_value(:,:,:,:), td_var%d_fill, &
-         &               il_detect(:,:,:),                       &
-         &               cd_method, id_radius )
-      ENDIF
+      CALL logger_info(" EXTRAP FILL: "//&
+         &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
+         &              " point(s) to extrapolate " )
+
+      !3- extrapolate
+      CALL extrap__3D(td_var%d_value(:,:,:,:), td_var%d_fill,    &
+      &               il_detect(:,:,:),                           &
+      &               cd_method, id_radius, id_maxiter  )
 
       DEALLOCATE(il_detect)
@@ -397,8 +705,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - compute coef indices to be used
-   !> - bug fix: force coef indice to 1, for dimension lenth equal to 1
+   !> - Nov, 2013- Initial Version
    !
    !> @param[inout] dd_value  3D array of variable to be extrapolated
@@ -409,31 +714,26 @@
    !-------------------------------------------------------------------
    SUBROUTINE extrap__3D( dd_value, dd_fill, id_detect,&
-   &                      cd_method, id_radius )
+   &                      cd_method, id_radius, id_maxiter )
       IMPLICIT NONE
       ! Argument
       REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value
-      REAL(dp)   ,                     INTENT(IN   ) :: dd_fill
-      INTEGER(i4), DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
-      CHARACTER(LEN=*),                INTENT(IN   ) :: cd_method
-      INTEGER(i4),                     INTENT(IN   ) :: id_radius
+      REAL(dp)   ,                   INTENT(IN   ) :: dd_fill
+      INTEGER(i4), DIMENSION(:,:,:), INTENT(INOUT) :: id_detect
+      CHARACTER(LEN=*),              INTENT(IN   ) :: cd_method
+      INTEGER(i4),                   INTENT(IN   ) :: id_radius
+      INTEGER(i4),                   INTENT(IN   ) :: id_maxiter
 
       ! local variable
-      INTEGER(i4)                                :: il_imin
-      INTEGER(i4)                                :: il_imax
-      INTEGER(i4)                                :: il_jmin
-      INTEGER(i4)                                :: il_jmax
-      INTEGER(i4)                                :: il_kmin
-      INTEGER(i4)                                :: il_kmax
-      INTEGER(i4)                                :: il_iter
-      INTEGER(i4)                                :: il_radius
-      INTEGER(i4)                                :: il_i1
-      INTEGER(i4)                                :: il_i2
-      INTEGER(i4)                                :: il_j1
-      INTEGER(i4)                                :: il_j2
-      INTEGER(i4)                                :: il_k1
-      INTEGER(i4)                                :: il_k2
-
-      INTEGER(i4), DIMENSION(4)                  :: il_shape
-      INTEGER(i4), DIMENSION(3)                  :: il_dim
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+      INTEGER(i4) :: il_kmin
+      INTEGER(i4) :: il_kmax
+      INTEGER(i4) :: il_iter
+      INTEGER(i4) :: il_radius
+
+      INTEGER(i4), DIMENSION(4) :: il_shape
+      INTEGER(i4), DIMENSION(3) :: il_dim
 
       INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
@@ -443,6 +743,4 @@
       REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdz
       REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef
-
-      LOGICAL                                    :: ll_iter
 
       ! loop indices
@@ -467,6 +765,5 @@
             DO WHILE( ANY(il_detect(:,:,:)==1) )
                ! change extend value to minimize number of iteration
-               il_radius=id_radius+(il_iter-1)
-               ll_iter=.TRUE.
+               il_radius=id_radius+(il_iter/id_maxiter)
 
                ALLOCATE( dl_dfdx(il_shape(1), il_shape(2), il_shape(3)) ) 
@@ -477,6 +774,5 @@
                dl_dfdx(:,:,:)=dd_fill
                IF( il_shape(1) > 1 )THEN
-                  dl_dfdx(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
-                     &                          dd_fill, 'I' )
+                  dl_dfdx(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'I' )
                ENDIF
 
@@ -484,6 +780,5 @@
                dl_dfdy(:,:,:)=dd_fill
                IF( il_shape(2) > 1 )THEN
-                  dl_dfdy(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
-                     &                          dd_fill, 'J' )
+                  dl_dfdy(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'J' )
                ENDIF
  
@@ -491,6 +786,5 @@
                dl_dfdz(:,:,:)=dd_fill
                IF( il_shape(3) > 1 )THEN
-                  dl_dfdz(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
-                     &                          dd_fill, 'K' )
+                  dl_dfdz(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'K' )
                ENDIF
  
@@ -510,5 +804,4 @@
 
                DO jk=1,il_shape(3)
-                  ! from North West(1,1) to South East(il_shape(1),il_shape(2))
                   IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
                   DO jj=1,il_shape(2)
@@ -520,40 +813,21 @@
                            il_imin=MAX(ji-il_radius,1)
                            il_imax=MIN(ji+il_radius,il_shape(1))
-                           ! coef indices to be used
-                           il_i1 = il_radius-(ji-il_imin)+1
-                           il_i2 = il_radius+(il_imax-ji)+1
                            IF( il_dim(1) == 1 )THEN
                               il_imin=ji
                               il_imax=ji
-                              ! coef indices to be used
-                              il_i1 = 1
-                              il_i2 = 1
                            ENDIF
-
 
                            il_jmin=MAX(jj-il_radius,1)
                            il_jmax=MIN(jj+il_radius,il_shape(2))
-                           ! coef indices to be used
-                           il_j1 = il_radius-(jj-il_jmin)+1
-                           il_j2 = il_radius+(il_jmax-jj)+1
                            IF( il_dim(2) == 1 )THEN
                               il_jmin=jj
                               il_jmax=jj
-                              ! coef indices to be used
-                              il_j1 = 1
-                              il_j2 = 1
                            ENDIF
 
                            il_kmin=MAX(jk-il_radius,1)
                            il_kmax=MIN(jk+il_radius,il_shape(3))
-                           ! coef indices to be used
-                           il_k1 = il_radius-(jk-il_kmin)+1
-                           il_k2 = il_radius+(il_kmax-jk)+1
                            IF( il_dim(3) == 1 )THEN
                               il_kmin=jk
                               il_kmax=jk
-                              ! coef indices to be used
-                              il_k1 = 1
-                              il_k2 = 1
                            ENDIF
 
@@ -571,85 +845,8 @@
                            &            il_jmin:il_jmax, &
                            &            il_kmin:il_kmax ), &
-                           &  dl_coef(il_i1:il_i2, &
-                           &          il_j1:il_j2, &
-                           &          il_k1:il_k2) )
+                           &  dl_coef(:,:,:) )
 
                            IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
                               il_detect(ji,jj,jk)= 0
-                              ll_iter=.FALSE.
-                           ENDIF
-
-                        ENDIF
-
-                     ENDDO
-                  ENDDO
-                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1)
-                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
-                  DO jj=il_shape(2),1,-1
-                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
-                     DO ji=il_shape(1),1,-1
-
-                        IF( il_detect(ji,jj,jk) == 1 )THEN
-                          
-                           il_imin=MAX(ji-il_radius,1)
-                           il_imax=MIN(ji+il_radius,il_shape(1))
-                           ! coef indices to be used
-                           il_i1 = il_radius-(ji-il_imin)+1
-                           il_i2 = il_radius+(il_imax-ji)+1
-                           IF( il_dim(1) == 1 )THEN
-                              il_imin=ji
-                              il_imax=ji
-                              ! coef indices to be used
-                              il_i1 = 1
-                              il_i2 = 1
-                           ENDIF
-
-
-                           il_jmin=MAX(jj-il_radius,1)
-                           il_jmax=MIN(jj+il_radius,il_shape(2))
-                           ! coef indices to be used
-                           il_j1 = il_radius-(jj-il_jmin)+1
-                           il_j2 = il_radius+(il_jmax-jj)+1
-                           IF( il_dim(2) == 1 )THEN
-                              il_jmin=jj
-                              il_jmax=jj
-                              ! coef indices to be used
-                              il_j1 = 1
-                              il_j2 = 1
-                           ENDIF
-
-                           il_kmin=MAX(jk-il_radius,1)
-                           il_kmax=MIN(jk+il_radius,il_shape(3))
-                           ! coef indices to be used
-                           il_k1 = il_radius-(jk-il_kmin)+1
-                           il_k2 = il_radius+(il_kmax-jk)+1
-                           IF( il_dim(3) == 1 )THEN
-                              il_kmin=jk
-                              il_kmax=jk
-                              ! coef indices to be used
-                              il_k1 = 1
-                              il_k2 = 1
-                           ENDIF
-
-                           dd_value(ji,jj,jk,jl)=extrap__3D_min_error_fill( &
-                           &  dd_value( il_imin:il_imax, &
-                           &            il_jmin:il_jmax, &
-                           &            il_kmin:il_kmax,jl ), dd_fill, il_radius, &
-                           &  dl_dfdx(  il_imin:il_imax, &
-                           &            il_jmin:il_jmax, &
-                           &            il_kmin:il_kmax ), &
-                           &  dl_dfdy(  il_imin:il_imax, &
-                           &            il_jmin:il_jmax, &
-                           &            il_kmin:il_kmax ), &
-                           &  dl_dfdz(  il_imin:il_imax, &
-                           &            il_jmin:il_jmax, &
-                           &            il_kmin:il_kmax ), &
-                           &  dl_coef(il_i1:il_i2, &
-                           &          il_j1:il_j2, &
-                           &          il_k1:il_k2) )
-
-                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
-                              il_detect(ji,jj,jk)= 0
-                              ll_iter=.FALSE.
                            ENDIF
 
@@ -665,5 +862,5 @@
                DEALLOCATE( dl_coef )
 
-               IF( ll_iter ) il_iter=il_iter+1
+               il_iter=il_iter+1
             ENDDO
          ENDDO
@@ -678,6 +875,5 @@
             DO WHILE( ANY(il_detect(:,:,:)==1) )
                ! change extend value to minimize number of iteration
-               il_radius=id_radius+(il_iter-1)
-               ll_iter=.TRUE.
+               il_radius=id_radius+(il_iter/id_maxiter)
 
                il_dim(1)=2*il_radius+1
@@ -690,11 +886,10 @@
                ALLOCATE( dl_coef(il_dim(1), il_dim(2), il_dim(3)) )
 
-               dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1),&
-               &                                                   1:il_dim(2),&
-               &                                                   1:il_dim(3),&
+               dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1), &
+               &                                                   1:il_dim(2), &
+               &                                                   1:il_dim(3), &
                &                                                   jl ) )
-               
+
                DO jk=1,il_shape(3)
-                  ! from North West(1,1) to South East(il_shape(1),il_shape(2))
                   IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
                   DO jj=1,il_shape(2)
@@ -706,39 +901,21 @@
                            il_imin=MAX(ji-il_radius,1)
                            il_imax=MIN(ji+il_radius,il_shape(1))
-                           ! coef indices to be used
-                           il_i1 = il_radius-(ji-il_imin)+1
-                           il_i2 = il_radius+(il_imax-ji)+1
                            IF( il_dim(1) == 1 )THEN
                               il_imin=ji
                               il_imax=ji
-                              ! coef indices to be used
-                              il_i1 = 1
-                              il_i2 = 1
                            ENDIF
 
                            il_jmin=MAX(jj-il_radius,1)
                            il_jmax=MIN(jj+il_radius,il_shape(2))
-                           ! coef indices to be used
-                           il_j1 = il_radius-(jj-il_jmin)+1
-                           il_j2 = il_radius+(il_jmax-jj)+1
                            IF( il_dim(2) == 1 )THEN
                               il_jmin=jj
                               il_jmax=jj
-                              ! coef indices to be used
-                              il_j1 = 1
-                              il_j2 = 1
                            ENDIF
 
                            il_kmin=MAX(jk-il_radius,1)
                            il_kmax=MIN(jk+il_radius,il_shape(3))
-                           ! coef indices to be used
-                           il_k1 = il_radius-(jk-il_kmin)+1
-                           il_k2 = il_radius+(il_kmax-jk)+1
                            IF( il_dim(3) == 1 )THEN
                               il_kmin=jk
                               il_kmax=jk
-                              ! coef indices to be used
-                              il_k1 = 1
-                              il_k2 = 1
                            ENDIF
 
@@ -748,76 +925,8 @@
                            &            il_kmin:il_kmax, &
                            &            jl), dd_fill, il_radius, &
-                           &  dl_coef(il_i1:il_i2, &
-                           &          il_j1:il_j2, &
-                           &          il_k1:il_k2) )
+                           &  dl_coef(:,:,:) )
 
                            IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
                               il_detect(ji,jj,jk)= 0
-                              ll_iter=.FALSE.
-                           ENDIF
-
-                        ENDIF
-
-                     ENDDO
-                  ENDDO
-                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1)
-                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
-                  DO jj=il_shape(2),1,-1
-                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
-                     DO ji=il_shape(1),1,-1
-
-                        IF( il_detect(ji,jj,jk) == 1 )THEN
-                           
-                           il_imin=MAX(ji-il_radius,1)
-                           il_imax=MIN(ji+il_radius,il_shape(1))
-                           ! coef indices to be used
-                           il_i1 = il_radius-(ji-il_imin)+1
-                           il_i2 = il_radius+(il_imax-ji)+1
-                           IF( il_dim(1) == 1 )THEN
-                              il_imin=ji
-                              il_imax=ji
-                              ! coef indices to be used
-                              il_i1 = 1
-                              il_i2 = 1
-                           ENDIF
-
-                           il_jmin=MAX(jj-il_radius,1)
-                           il_jmax=MIN(jj+il_radius,il_shape(2))
-                           ! coef indices to be used
-                           il_j1 = il_radius-(jj-il_jmin)+1
-                           il_j2 = il_radius+(il_jmax-jj)+1
-                           IF( il_dim(2) == 1 )THEN
-                              il_jmin=jj
-                              il_jmax=jj
-                              ! coef indices to be used
-                              il_j1 = 1
-                              il_j2 = 1
-                           ENDIF
-
-                           il_kmin=MAX(jk-il_radius,1)
-                           il_kmax=MIN(jk+il_radius,il_shape(3))
-                           ! coef indices to be used
-                           il_k1 = il_radius-(jk-il_kmin)+1
-                           il_k2 = il_radius+(il_kmax-jk)+1
-                           IF( il_dim(3) == 1 )THEN
-                              il_kmin=jk
-                              il_kmax=jk
-                              ! coef indices to be used
-                              il_k1 = 1
-                              il_k2 = 1
-                           ENDIF
-
-                           dd_value(ji,jj,jk,jl)=extrap__3D_dist_weight_fill( &
-                           &  dd_value( il_imin:il_imax, &
-                           &            il_jmin:il_jmax, &
-                           &            il_kmin:il_kmax, &
-                           &            jl), dd_fill, il_radius, &
-                           &  dl_coef(il_i1:il_i2, &
-                           &          il_j1:il_j2, &
-                           &          il_k1:il_k2) )
-
-                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
-                              il_detect(ji,jj,jk)= 0
-                              ll_iter=.FALSE.
                            ENDIF
 
@@ -827,10 +936,7 @@
                   ENDDO
                ENDDO
-               CALL logger_info(" EXTRAP 3D: "//&
-               &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
-               &              " point(s) to extrapolate " )
-            
+
                DEALLOCATE( dl_coef )
-               IF( ll_iter ) il_iter=il_iter+1
+               il_iter=il_iter+1
             ENDDO
          ENDDO            
@@ -840,4 +946,546 @@
 
    END SUBROUTINE extrap__3D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 1D array.
+   !> 
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> - November, 2013- Initial Version
+   !
+   !> @param[in] dd_value     1D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_discont   logical to take into account east west discontinuity 
+   !-------------------------------------------------------------------
+   PURE FUNCTION extrap_deriv_1D( dd_value, dd_fill, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(IN) :: dd_value
+      REAL(dp)                 , INTENT(IN) :: dd_fill
+      LOGICAL                  , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1) ) :: extrap_deriv_1D
+
+      ! local variable
+      INTEGER(i4)                            :: il_imin
+      INTEGER(i4)                            :: il_imax
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+
+      REAL(dp)                               :: dl_min
+      REAL(dp)                               :: dl_max
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+      !----------------------------------------------------------------
+      ! init
+      extrap_deriv_1D(:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:))
+
+      ALLOCATE( dl_value(3))
+
+      ! compute derivative in i-direction
+      DO ji=1,il_shape(1)
+         
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2)=dd_value(il_imin:il_imax)
+            IF( il_imin == 1 )THEN
+               dl_value(:)=EOSHIFT( dl_value(:), &
+               &                    DIM=1,         &
+               &                    SHIFT=-1,      &
+               &                    BOUNDARY=dl_value(1) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:)=EOSHIFT( dl_value(:), &
+               &                    DIM=1,         &
+               &                    SHIFT=1,       &
+               &                    BOUNDARY=dl_value(3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:), dl_value(:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:), dl_value(:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:) < 0._dp ) 
+                     dl_value(:) = dl_value(:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:) > 180._dp ) 
+                     dl_value(:) = dl_value(:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+         IF( dl_value( 2) /= dd_fill .AND. & ! ji
+         &   dl_value( 3) /= dd_fill .AND. & ! ji+1
+         &   dl_value( 1) /= dd_fill )THEN   ! ji-1
+
+            extrap_deriv_1D(ji)=&
+            &  ( dl_value(3) - dl_value(1) ) / &
+            &  REAL( il_imax-il_imin ,dp)
+
+         ENDIF
+
+      ENDDO
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION extrap_deriv_1D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 2D array.
+   !> you have to specify in which direction derivative have to be computed:
+   !> first (I) or second (J) dimension. 
+   !>
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> - November, 2013- Initial Version
+   !
+   !> @param[in] dd_value     2D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] cd_dim       compute derivative on first (I) or second (J) dimension 
+   !> @param[in] ld_discont   logical to take into account east west discontinuity 
+   !-------------------------------------------------------------------
+   FUNCTION extrap_deriv_2D( dd_value, dd_fill, cd_dim, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_value
+      REAL(dp)                   , INTENT(IN) :: dd_fill
+      CHARACTER(LEN=*)           , INTENT(IN) :: cd_dim
+      LOGICAL                    , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
+      &                   SIZE(dd_value,DIM=2) ) :: extrap_deriv_2D
+
+      ! local variable
+      INTEGER(i4)                              :: il_imin
+      INTEGER(i4)                              :: il_imax
+      INTEGER(i4)                              :: il_jmin
+      INTEGER(i4)                              :: il_jmax
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+
+      REAL(dp)                                 :: dl_min
+      REAL(dp)                                 :: dl_max
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                  :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      !----------------------------------------------------------------
+      ! init
+      extrap_deriv_2D(:,:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:,:))
+
+      SELECT CASE(TRIM(fct_upper(cd_dim)))
+
+      CASE('I')
+
+         ALLOCATE( dl_value(3,il_shape(2)) )
+         ! compute derivative in i-direction
+         DO ji=1,il_shape(1)
+
+            ! init
+            dl_value(:,:)=dd_fill
+            
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2,:)=dd_value(il_imin:il_imax,:)
+            IF( il_imin == 1 )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(1,:) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(3,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:) < 0_dp ) 
+                     dl_value(:,:) = dl_value(:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:) > 180 ) 
+                     dl_value(:,:) = dl_value(:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+            
+            WHERE( dl_value(2,:) /= dd_fill .AND. &  ! ji
+            &      dl_value(3,:) /= dd_fill .AND. &  ! ji+1
+            &      dl_value(1,:) /= dd_fill )        ! ji-1
+
+               extrap_deriv_2D(ji,:)=&
+               &  ( dl_value(3,:) - dl_value(1,:) ) / &
+               &    REAL( il_imax-il_imin,dp)
+
+            END WHERE
+
+         ENDDO
+
+      CASE('J')
+
+         ALLOCATE( dl_value(il_shape(1),3) )
+         ! compute derivative in j-direction
+         DO jj=1,il_shape(2)
+         
+            il_jmin=MAX(jj-1,1)
+            il_jmax=MIN(jj+1,il_shape(2))
+
+            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=3
+            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=2
+            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
+               j1=2  ; j2=3
+            ENDIF
+
+            dl_value(:,j1:j2)=dd_value(:,il_jmin:il_jmax)
+            IF( il_jmin == 1 )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,1))
+            ENDIF
+            IF( il_jmax == il_shape(2) )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:) < 0_dp ) 
+                     dl_value(:,:) = dl_value(:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:) > 180 ) 
+                     dl_value(:,:) = dl_value(:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(:, 2) /= dd_fill .AND. & ! jj
+            &      dl_value(:, 3) /= dd_fill .AND. & ! jj+1
+            &      dl_value(:, 1) /= dd_fill )       ! jj-1
+
+               extrap_deriv_2D(:,jj)=&
+               &  ( dl_value(:,3) - dl_value(:,1) ) / &
+               &   REAL(il_jmax-il_jmin,dp)         
+
+            END WHERE
+
+         ENDDO
+         
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION extrap_deriv_2D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 3D array.
+   !> you have to specify in which direction derivative have to be computed:
+   !> first (I), second (J) or third (K) dimension.
+   !> 
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> - November, 2013- Initial Version
+   !
+   !> @param[inout] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] cd_dim       compute derivative on first (I) second (J) or third (K) dimension   
+   !> @param[in] ld_discont   logical to take into account east west discontinuity
+   !-------------------------------------------------------------------
+   PURE FUNCTION extrap_deriv_3D( dd_value, dd_fill, cd_dim, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+      REAL(dp)                          , INTENT(IN) :: dd_fill
+      CHARACTER(LEN=*)                  , INTENT(IN) :: cd_dim
+      LOGICAL                           , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
+      &                   SIZE(dd_value,DIM=2), &
+      &                   SIZE(dd_value,DIM=3)) :: extrap_deriv_3D
+
+      ! local variable
+      INTEGER(i4)                                :: il_imin
+      INTEGER(i4)                                :: il_imax
+      INTEGER(i4)                                :: il_jmin
+      INTEGER(i4)                                :: il_jmax
+      INTEGER(i4)                                :: il_kmin
+      INTEGER(i4)                                :: il_kmax
+      INTEGER(i4), DIMENSION(3)                  :: il_shape
+
+      REAL(dp)                                   :: dl_min
+      REAL(dp)                                   :: dl_max
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                    :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      
+      INTEGER(i4) :: k1
+      INTEGER(i4) :: k2      
+      !----------------------------------------------------------------
+      ! init
+      extrap_deriv_3D(:,:,:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+
+      SELECT CASE(TRIM(fct_upper(cd_dim)))
+
+      CASE('I')
+
+         ALLOCATE( dl_value(3,il_shape(2),il_shape(3)) )
+         ! compute derivative in i-direction
+         DO ji=1,il_shape(1)
+            
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2,:,:)=dd_value(il_imin:il_imax,:,:)
+            IF( il_imin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(1,:,:) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(3,:,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(2,:,:) /= dd_fill .AND. & ! ji
+            &      dl_value(3,:,:) /= dd_fill .AND. & !ji+1 
+            &      dl_value(1,:,:) /= dd_fill )       !ji-1
+
+               extrap_deriv_3D(ji,:,:)= &
+               &  ( dl_value(3,:,:) - dl_value(1,:,:) ) / &
+               &  REAL( il_imax-il_imin ,dp)
+
+            END WHERE
+
+         ENDDO
+
+      CASE('J')
+
+         ALLOCATE( dl_value(il_shape(1),3,il_shape(3)) )
+         ! compute derivative in j-direction
+         DO jj=1,il_shape(2)
+         
+            il_jmin=MAX(jj-1,1)
+            il_jmax=MIN(jj+1,il_shape(2))
+
+            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=3
+            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=2
+            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
+               j1=2  ; j2=3
+            ENDIF
+
+            dl_value(:,j1:j2,:)=dd_value(:,il_jmin:il_jmax,:)
+            IF( il_jmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,1,:) )
+            ENDIF
+            IF( il_jmax == il_shape(2) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(:,3,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(:, 2,:) /= dd_fill .AND. & ! jj
+               &   dl_value(:, 3,:) /= dd_fill .AND. & ! jj+1
+            &      dl_value(:, 1,:) /= dd_fill )       ! jj-1
+
+               extrap_deriv_3D(:,jj,:)=&
+               &  ( dl_value(:,3,:) - dl_value(:,1,:) ) / &
+               &  REAL( il_jmax - il_jmin ,dp)         
+
+            END WHERE
+
+         ENDDO
+         
+      CASE('K')
+         ! compute derivative in k-direction
+         DO jk=1,il_shape(3)
+
+            il_kmin=MAX(jk-1,1)
+            il_kmax=MIN(jk+1,il_shape(3))
+
+            IF( il_kmin==jk-1 .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=3
+            ELSEIF( il_kmin==jk .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=2
+            ELSEIF( il_kmin==jk-1 .AND. il_kmax==jk )THEN
+               k1=2  ; k2=3
+            ENDIF
+
+            dl_value(:,:,k1:k2)=dd_value(:,:,il_kmin:il_kmax)
+            IF( il_kmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=3,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,:,1) )
+            ENDIF
+            IF( il_kmax == il_shape(3) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                        DIM=3,         &
+               &                        SHIFT=1,       &
+               &                        BOUNDARY=dl_value(:,:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF         
+
+            WHERE( dl_value(:,:, 2) /= dd_fill .AND. & ! jk
+               &   dl_value(:,:, 3) /= dd_fill .AND. & ! jk+1
+               &   dl_value(:,:, 1) /= dd_fill )       ! jk-1
+
+               extrap_deriv_3D(:,:,jk)=&
+               &  ( dl_value(:,:,3) - dl_value(:,:,1) ) / &
+               &  REAL( il_kmax-il_kmin,dp)         
+
+            END WHERE
+
+         ENDDO
+
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION extrap_deriv_3D
    !-------------------------------------------------------------------
    !> @brief
@@ -845,11 +1493,9 @@
    !> 
    !> @details 
-   !> coefficients are  "grid distance" to the center of the box 
-   !> choosed to compute extrapolation.
+   !> coefficients are  "grid distance" to the center of the box choosed to compute
+   !> extrapolation.
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - decrease weight of third dimension
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -898,8 +1544,7 @@
 
                ! compute distance
-               ! "vertical weight" is lower than horizontal 
                dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
                &                   (jj-il_jmid)**2 + &
-               &                 3*(jk-il_kmid)**2
+               &                   (jk-il_kmid)**2
 
                IF( dl_dist(ji,jj,jk) /= 0 )THEN
@@ -924,5 +1569,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1013,7 +1658,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - decrease weight of third dimension
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1062,8 +1705,7 @@
 
                ! compute distance
-               ! "vertical weight" is lower than horizontal 
                dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
                &                   (jj-il_jmid)**2 + &
-               &                 3*(jk-il_kmid)**2
+               &                   (jk-il_kmid)**2
 
                IF( dl_dist(ji,jj,jk) /= 0 )THEN
@@ -1090,5 +1732,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1121,4 +1763,5 @@
       INTEGER(i4) :: jj
       INTEGER(i4) :: jk
+
       !----------------------------------------------------------------
 
@@ -1150,5 +1793,4 @@
             ENDDO
          ENDDO
-
 
          ! return value
@@ -1173,5 +1815,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013-Initial version
    !
    !> @param[inout] td_var variable 
@@ -1275,5 +1917,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013-Initial version
    !>
    !> @param[inout] td_var variable 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/file.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 10251)
@@ -137,7 +137,6 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date November, 2013 - Initial Version
-!> @date November, 2014 
-!> - Fix memory leaks bug
+!> @date November, 2013- Initial Version
+!> @date November, 2014 - Fix memory leaks bug
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -289,7 +288,7 @@
    !>   
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date November, 2014
-   !> - use function instead of overload assignment operator 
+   !>    - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -410,7 +409,7 @@
    !>   
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date November, 2014
-   !> - use function instead of overload assignment operator 
+   !>    - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -449,5 +448,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_file   file name
@@ -554,5 +553,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_file   file name
@@ -590,5 +589,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -605,7 +604,6 @@
       CHARACTER(LEN=lc) :: cl_dim
       LOGICAL           :: ll_error
-      LOGICAL           :: ll_warn 
-
-      INTEGER(i4)       :: il_ind
+
+      INTEGER(i4) :: il_ind
 
       ! loop indices
@@ -616,5 +614,4 @@
       ! check used dimension 
       ll_error=.FALSE.
-      ll_warn=.FALSE.
       DO ji=1,ip_maxdim
          il_ind=dim_get_index( td_file%t_dim(:), &
@@ -622,18 +619,21 @@
          &                     TRIM(td_var%t_dim(ji)%c_sname))
          IF( il_ind /= 0 )THEN
-            IF( td_var%t_dim(ji)%l_use  .AND. &
-            &   td_file%t_dim(il_ind)%l_use .AND. &
-            &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN
-               IF( INDEX( TRIM(td_var%c_axis), &
-               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN
-                  ll_warn=.TRUE.
-               ELSE
-                  ll_error=.TRUE.
-               ENDIF
-            ENDIF
+         IF( td_var%t_dim(ji)%l_use  .AND. &
+         &   td_file%t_dim(il_ind)%l_use .AND. &
+         &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN
+            ll_error=.TRUE.
+         ENDIF
          ENDIF
       ENDDO
 
       IF( ll_error )THEN
+
+         file_check_var_dim=.FALSE.
+
+         CALL logger_error( &
+         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_file%c_name))
+
 
          cl_dim='(/'
@@ -659,17 +659,4 @@
          CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
 
-         file_check_var_dim=.FALSE.
-
-         CALL logger_error( &
-         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
-         &  " for variable "//TRIM(td_var%c_name)//&
-         &  " and file "//TRIM(td_file%c_name))
-
-      ELSEIF( ll_warn )THEN
-         CALL logger_warn( &
-         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
-         &  " for variable "//TRIM(td_var%c_name)//&
-         &  " and file "//TRIM(td_file%c_name)//". you should use"//&
-         &  " var_check_dim to remove useless dimension.")
       ELSE
 
@@ -692,5 +679,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - add dimension to file if need be
@@ -720,7 +707,7 @@
       IF( TRIM(td_file%c_name) == '' )THEN
 
+         CALL logger_error( " FILE ADD VAR: structure file unknown" )
          CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//&
          & "running file_add_var" )
-         CALL logger_error( " FILE ADD VAR: structure file unknown" )
 
       ELSE
@@ -736,6 +723,5 @@
                &                                       td_var%c_stdname )
             ENDIF
-            CALL logger_debug( &
-            &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) )
+
             IF( il_ind /= 0 )THEN
 
@@ -753,5 +739,5 @@
             ELSE
 
-               CALL logger_debug( &
+               CALL logger_trace( &
                &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//&
                &  ", standard name "//TRIM(td_var%c_stdname)//&
@@ -784,4 +770,6 @@
                         !il_rec=td_file%t_dim(3)%i_len
                   END SELECT
+                  CALL logger_info( &
+                     &  " FILE ADD VAR: variable index "//TRIM(fct_str(il_ind)))
 
                   IF( td_file%i_nvar > 0 )THEN
@@ -818,5 +806,5 @@
                         ENDIF
 
-                        IF( il_ind < td_file%i_nvar+1 )THEN
+                        IF( il_ind < td_file%i_nvar )THEN
                            ! variable with more dimension than new variable
                            td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = &
@@ -905,7 +893,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 
-   !> - define local variable structure to avoid mistake with pointer
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -921,5 +907,4 @@
       ! local variable
       INTEGER(i4)       :: il_ind
-      TYPE(TVAR)        :: tl_var
       !----------------------------------------------------------------
 
@@ -943,10 +928,9 @@
             IF( il_ind /= 0 )THEN
    
-               tl_var=var_copy(td_file%t_var(il_ind))
-               CALL file_del_var(td_file, tl_var)
+               CALL file_del_var(td_file, td_file%t_var(il_ind))
 
             ELSE
 
-               CALL logger_debug( &
+               CALL logger_warn( &
                &  " FILE DEL VAR NAME: there is no variable with name or "//&
                &  "standard name "//TRIM(cd_name)//" in file "//&
@@ -969,5 +953,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_file   file structure
@@ -1112,5 +1096,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1147,5 +1131,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1263,8 +1247,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 
-   !> - define local attribute structure to avoid mistake
-   !> with pointer
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1280,5 +1261,4 @@
       ! local variable
       INTEGER(i4)       :: il_ind
-      TYPE(TATT)        :: tl_att
       !----------------------------------------------------------------
 
@@ -1302,10 +1282,9 @@
             IF( il_ind /= 0 )THEN
    
-               tl_att=att_copy(td_file%t_att(il_ind))
-               CALL file_del_att(td_file, tl_att)
+               CALL file_del_att(td_file, td_file%t_att(il_ind))
 
             ELSE
 
-               CALL logger_debug( &
+               CALL logger_warn( &
                &  " FILE DEL ATT NAME: there is no attribute with name "//&
                &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name))
@@ -1326,5 +1305,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1424,5 +1403,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1465,5 +1444,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - do not reorder dimension, before put in file
@@ -1550,5 +1529,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1630,5 +1609,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1673,5 +1652,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1738,5 +1717,5 @@
          WRITE(*,'(/a)') " File variable"
          DO ji=1,td_file%i_nvar
-            CALL var_print(td_file%t_var(ji),.FALSE.)
+            CALL var_print(td_file%t_var(ji))!,.FALSE.)
          ENDDO
       ENDIF
@@ -1751,5 +1730,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_file   file structure
@@ -1790,10 +1769,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 
-   !> - add case to not return date (yyyymmdd) at the end of filename
-   !> @date February, 2015 
-   !> - add case to not return release number
-   !> we assume release number only on one digit (ex : file_v3.5.nc)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_file   file name (without suffix)
@@ -1829,10 +1803,4 @@
          IF( .NOT. fct_is_num(file__get_number(2:)) )THEN
             file__get_number=''
-         ELSEIF( LEN(TRIM(file__get_number))-1 == 8 )THEN
-            ! date case yyyymmdd
-            file__get_number=''
-         ELSEIF( LEN(TRIM(file__get_number))-1 == 1 )THEN
-            ! release number case 
-            file__get_number=''
          ENDIF
       ELSE
@@ -1848,5 +1816,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1911,5 +1879,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1938,5 +1906,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2051,5 +2019,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   array of file structure
@@ -2089,5 +2057,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !
    !> @param[in] td_file   array of file 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/filter.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 10251)
@@ -18,6 +18,5 @@
 !>          - rad > cutoff : @f$ filter=0 @f$               
 !>       - 'blackman'
-!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 
-!>                                      0.08*COS(2\pi*\frac{rad}{cutoff}) @f$
+!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 0.08*COS(2\pi*\frac{rad}{cutoff}) @f$
 !>          - rad > cutoff : @f$ filter=0 @f$
 !>       - 'gauss'
@@ -30,10 +29,7 @@
 !>
 !>    td_var\%c_filter(2) string character is the number of turn to be done<br/>
-!>    td_var\%c_filter(3) string character is the cut-off frequency 
-! >                       (count in number of mesh grid)<br/>
-!>    td_var\%c_filter(4) string character is the halo radius 
-!>                        (count in number of mesh grid)<br/>
-!>    td_var\%c_filter(5) string character is the alpha parameter 
-!>                        (for gauss and butterworth method)<br/>
+!>    td_var\%c_filter(3) string character is the cut-off frequency (count in number of mesh grid)<br/>
+!>    td_var\%c_filter(4) string character is the halo radius (count in number of mesh grid)<br/>
+!>    td_var\%c_filter(5) string character is the alpha parameter (for gauss and butterworth method)<br/>
 !>    
 !>    @note Filter method could be specify for each variable in namelist _namvar_,
@@ -44,6 +40,5 @@
 !>    The number of turn is specify using '*' separator.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:flt=2*hamming(@f$cutoff@f$,@f$radius@f$)', 
-!>                    'varname2:flt=gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)'
+!>       - cn_varinfo='varname1:2*hamming(@f$cutoff@f$,@f$radius@f$)', 'varname2:gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)'
 !>
 !>    to filter variable value:<br/>
@@ -111,5 +106,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure 
@@ -255,5 +250,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable 
@@ -301,5 +296,5 @@
 
       !3-extrapolate
-      CALL extrap_fill_value( td_var ) !, id_iext=id_radius, id_jext=id_radius )
+      CALL extrap_fill_value( td_var, id_iext=id_radius, id_jext=id_radius )
 
       !4-filtering
@@ -346,5 +341,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -398,5 +393,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -444,5 +439,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -487,5 +482,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -542,5 +537,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - Nov, 2013- Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -595,5 +590,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name   filter name
@@ -654,5 +649,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name   filter name
@@ -700,5 +695,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -754,5 +749,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -813,5 +808,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -868,5 +863,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -927,5 +922,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -983,5 +978,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1043,5 +1038,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1095,5 +1090,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1151,5 +1146,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1203,5 +1198,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/function.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 10251)
@@ -51,9 +51,4 @@
 !> @endcode
 !>
-!>  to check if character is real
-!> @code
-!>  ll_is_real=fct_is_real(cd_var)
-!> @endcode
-!>
 !>  to split string into substring and return one of the element:<br/>  
 !> @code
@@ -94,6 +89,5 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date September, 2014 
-!> - add header
+!> @date September, 2014 - add header
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -112,5 +106,4 @@
    PUBLIC :: fct_lower    !< convert character from upper to lower case
    PUBLIC :: fct_is_num   !< check if character is numeric
-   PUBLIC :: fct_is_real  !< check if character is real
    PUBLIC :: fct_split    !< split string into substring
    PUBLIC :: fct_basename !< return basename (name without path)
@@ -160,5 +153,5 @@
    ! 
    !> @author J.Paul 
-   !> @date September, 2014 - Initial Version 
+   !> - September, 2014- Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -184,5 +177,5 @@
    ! 
    !> @author J.Paul 
-   !> @date September, 2014 - Initial Version 
+   !> - September, 2014- Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -208,5 +201,5 @@
    ! 
    !> @author J.Paul 
-   !> @date November, 2013 - Initial Version 
+   !> - Nov, 2013- Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -232,5 +225,5 @@
    ! 
    !> @author J.Paul 
-   !> @date November, 2013 - Initial Version 
+   !> - November, 2013- Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -256,5 +249,5 @@
    ! 
    !> @author J.Paul 
-   !> @date November, 2013 - Initial Version 
+   !> - November, 2013- Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -280,5 +273,5 @@
    !>
    !> @author J.Paul 
-   !> @date November, 2013 - Initial Version 
+   !> - November, 2013- Initial Version 
    !>
    !> @param[in] cd_char   string character
@@ -304,5 +297,5 @@
    !>
    !> @author J.Paul 
-   !> @date November, 2013 - Initial Version 
+   !> - November, 2013- Initial Version 
    !>
    !> @param[in] cd_char   string character
@@ -328,5 +321,5 @@
    !>
    !> @author J.Paul 
-   !> @date November, 2013 - Initial Version 
+   !> - November, 2013- Initial Version 
    !>
    !> @return file id 
@@ -351,5 +344,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] id_status
@@ -372,5 +365,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2014 - Initial Version
+   !> - November, 2014- Initial Version
    !>
    !> @param[in] cd_msg optional message to be added
@@ -394,5 +387,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] ld_var logical variable
@@ -416,5 +409,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] bd_var integer(1) variable
@@ -438,5 +431,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] sd_var integer(2) variable
@@ -460,5 +453,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] id_var integer(4) variable
@@ -482,5 +475,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] kd_var integer(8) variable
@@ -504,5 +497,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] rd_var real(4) variable
@@ -526,5 +519,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_var real(8) variable
@@ -551,5 +544,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_arr array of character
@@ -597,5 +590,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_var character
@@ -654,5 +647,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_var character
@@ -704,5 +697,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_var character
@@ -730,67 +723,4 @@
    END FUNCTION fct_is_num
    !-------------------------------------------------------------------
-   !> @brief This function check if character is real number.
-   !
-   !> @details
-   !> it allows exponantial and decimal number
-   !> exemple :  1e6, 2.3
-   !>
-   !> @author J.Paul
-   !> @date June, 2015 - Initial Version
-   !
-   !> @param[in] cd_var character
-   !> @return character is numeric
-   !-------------------------------------------------------------------
-   PURE LOGICAL FUNCTION fct_is_real(cd_var)
-      IMPLICIT NONE
-      ! Argument      
-      CHARACTER(LEN=*), INTENT(IN) :: cd_var
-   
-      ! local variables
-      LOGICAL :: ll_exp
-      LOGICAL :: ll_dec
-   
-      ! loop indices
-      INTEGER :: ji
-      !----------------------------------------------------------------
-   
-      ll_exp=.TRUE.
-      ll_dec=.FALSE.
-      DO ji=1,LEN(TRIM(cd_var))
-         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. &
-         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN
-   
-            fct_is_real=.TRUE.
-            ll_exp=.FALSE.
-      
-         ELSEIF( TRIM(cd_var(ji:ji))=='e' )THEN
-         
-            IF( ll_exp .OR. ji== LEN(TRIM(cd_var)) )THEN
-               fct_is_real=.FALSE.
-               EXIT
-            ELSE 
-               ll_exp=.TRUE.
-            ENDIF
-   
-         ELSEIF( TRIM(cd_var(ji:ji))=='.' )THEN
-   
-            IF( ll_dec )THEN
-               fct_is_real=.FALSE.
-               EXIT
-            ELSE
-               fct_is_real=.TRUE.
-               ll_dec=.TRUE.
-            ENDIF
-   
-         ELSE
-   
-            fct_is_real=.FALSE.
-            EXIT
-   
-         ENDIF
-      ENDDO
-   
-   END FUNCTION fct_is_real
-   !-------------------------------------------------------------------
    !> @brief This function split string of character 
    !> using separator character, by default '|',
@@ -798,5 +728,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_string string of character
@@ -878,5 +808,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_string string of character
@@ -943,5 +873,5 @@
    !> Optionally you could specify another separator.
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_string filename
@@ -984,5 +914,5 @@
    !> Optionally you could specify another separator.
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_string filename
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/grid.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 10251)
@@ -149,5 +149,5 @@
 !>    CALL grid_check_coincidence(td_coord0, td_coord1, 
 !>                                id_imin0, id_imax0, id_jmin0, id_jmax0
-!>                                ,id_rho)
+!>                                [,id_rho])
 !> @endcode
 !>       - td_coord0 is coarse grid coordinate mpp structure
@@ -161,5 +161,5 @@
 !>       - id_jmax0  is coarse grid upper right corner j-indice of fine grid 
 !> domain 
-!>       - id_rho    is array of refinement factor 
+!>       - id_rho    is array of refinement factor (default 1)
 !>
 !>    to add ghost cell at boundaries:<br/>
@@ -213,6 +213,4 @@
 !> @date October, 2014
 !> - use mpp file structure instead of file
-!> @date February, 2015
-!> - add function grid_fill_small_msk to fill small domain inside bigger one
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -257,5 +255,4 @@
    PUBLIC :: grid_split_domain         !< compute closed sea domain 
    PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value 
-   PUBLIC :: grid_fill_small_msk       !< fill small domain inside bigger one 
 
                                      ! get closest coarse grid indices of fine grid domain
@@ -355,5 +352,5 @@
    !> @note need all processor files to be there
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !>
    !> @param[inout] td_file file structure 
@@ -469,7 +466,7 @@
    !> - compute East West overlap
    !>
-   !> @note need all processor files
+   !> @note need all processor files to be there
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !>
    !> @param[in] td_mpp mpp structure 
@@ -499,5 +496,4 @@
       il_ew   =-1
 
-      CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name))
       ! copy structure
       tl_mpp=mpp_copy(td_mpp)
@@ -527,11 +523,9 @@
       ENDIF
 
-      CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio)))
-
       SELECT CASE(il_perio)
       CASE(3,4)
+         il_pivot=0
+      CASE(5,6)
          il_pivot=1
-      CASE(5,6)
-         il_pivot=0
       CASE(0,1,2)
          il_pivot=1
@@ -540,5 +534,4 @@
       IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
          ! get pivot
-         CALL logger_info("GRID GET INFO: look for pivot ")
          il_pivot=grid_get_pivot(tl_mpp)
       ENDIF
@@ -546,5 +539,4 @@
       IF( il_perio < 0 .OR. il_perio > 6 )THEN
          ! get periodicity
-         CALL logger_info("GRID GET INFO: look for perio ")
          il_perio=grid_get_perio(tl_mpp, il_pivot)
       ENDIF
@@ -552,5 +544,4 @@
       IF( il_ew < 0 )THEN
          ! get periodicity
-         CALL logger_info("GRID GET INFO: look for overlap ")
          il_ew=grid_get_ew_overlap(tl_mpp)
       ENDIF
@@ -604,5 +595,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !> @date September, 2014
    !> - add dummy loop in case variable not over right point.
@@ -717,5 +708,5 @@
    !> 
    !> @author J.Paul
-   !> @date October, 2014 - Initial version
+   !> - October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -792,5 +783,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: F-pivot")
+            CALL logger_info("GRID GET PIVOT: T-pivot")
             grid__get_pivot_varT=0
          ENDIF
@@ -810,5 +801,5 @@
    !> 
    !> @author J.Paul
-   !> @date October, 2014 - Initial version
+   !> - October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -885,5 +876,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: F-pivot")
+            CALL logger_info("GRID GET PIVOT: T-pivot")
             grid__get_pivot_varU=0
          ENDIF
@@ -903,5 +894,5 @@
    !> 
    !> @author J.Paul
-   !> @date October, 2014 - Initial version
+   !> - October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -978,5 +969,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: F-pivot")
+            CALL logger_info("GRID GET PIVOT: T-pivot")
             grid__get_pivot_varV=0
          ENDIF
@@ -996,5 +987,5 @@
    !> 
    !> @author J.Paul
-   !> @date October, 2014 - Initial version
+   !> - October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -1071,5 +1062,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: F-pivot")
+            CALL logger_info("GRID GET PIVOT: T-pivot")
             grid__get_pivot_varF=0
          ENDIF
@@ -1092,5 +1083,5 @@
    !>
    !> @author J.Paul
-   !> @date Ocotber, 2014 - Initial version
+   !> - Ocotber, 2014- Initial version
    !
    !> @param[in] td_file file structure
@@ -1181,5 +1172,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial version
+   !> - October, 2014 - Initial version
    !
    !> @param[in] td_mpp   mpp file structure
@@ -1286,13 +1277,13 @@
    !> 1: cyclic east-west boundary
    !> 2: symmetric boundary condition across the equator
-   !> 3: North fold boundary (with a T-point pivot)
-   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
-   !> 5: North fold boundary (with a F-point pivot)
-   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !> 3: North fold boundary (with a F-point pivot)
+   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a T-point pivot)
+   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary
    !>
    !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013- Subroutine written
    !> @date October, 2014
    !> - work on variable structure instead of file structure
@@ -1461,5 +1452,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial version
+   !> - October, 2014 - Initial version
    !>
    !> @param[in] td_file   file structure
@@ -1546,13 +1537,13 @@
    !> 1: cyclic east-west boundary
    !> 2: symmetric boundary condition across the equator
-   !> 3: North fold boundary (with a T-point pivot)
-   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
-   !> 5: North fold boundary (with a F-point pivot)
-   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !> 3: North fold boundary (with a F-point pivot)
+   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a T-point pivot)
+   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary
    !>
    !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial version
+   !> - October, 2014 - Initial version
    !
    !> @param[in] td_mpp   mpp file structure
@@ -1643,5 +1634,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1755,5 +1746,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !>
    !> @param[in] td_file file structure 
@@ -1806,5 +1797,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1862,5 +1853,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_lat latitude variable structure 
@@ -1899,5 +1890,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1987,12 +1978,9 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - use grid point to read coordinates variable. 
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
-   !> @date February, 2015
-   !> - use longitude or latitude as standard name, if can not find 
-   !> longitude_T, latitude_T...
    !>
    !> @param[in] td_coord0 coarse grid coordinate mpp structure
@@ -2016,25 +2004,24 @@
 
       ! local variable
-      CHARACTER(LEN= 1)                        :: cl_point
-      CHARACTER(LEN=lc)                        :: cl_name
-
-      INTEGER(i4)                              :: il_imin0
-      INTEGER(i4)                              :: il_imax0
-      INTEGER(i4)                              :: il_jmin0
-      INTEGER(i4)                              :: il_jmax0
-      INTEGER(i4)                              :: il_ind
-
-      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
-      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
-
-      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
-
-      TYPE(TVAR)                               :: tl_lon0
-      TYPE(TVAR)                               :: tl_lat0
-      TYPE(TVAR)                               :: tl_lon1
-      TYPE(TVAR)                               :: tl_lat1
-
-      TYPE(TMPP)                               :: tl_coord0
-      TYPE(TMPP)                               :: tl_coord1
+      TYPE(TMPP) :: tl_coord0
+      TYPE(TMPP) :: tl_coord1
+
+      TYPE(TVAR)  :: tl_lon0
+      TYPE(TVAR)  :: tl_lat0
+      TYPE(TVAR)  :: tl_lon1
+      TYPE(TVAR)  :: tl_lat1
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1
+
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_jmax0
+
+      CHARACTER(LEN= 1) :: cl_point
+      CHARACTER(LEN=lc) :: cl_name
 
       ! loop indices
@@ -2070,21 +2057,6 @@
          ! read coarse longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'longitude'
-         ENDIF
          tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
-
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
-            &  try to use latitude.")
-            WRITE(cl_name,*) 'latitude'
-         ENDIF
          tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
          
@@ -2105,21 +2077,6 @@
          ! read fine longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'longitude'
-         ENDIF
          tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
-
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
-            &  try to use latitude.")
-            WRITE(cl_name,*) 'latitude'
-         ENDIF
          tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
  
@@ -2170,12 +2127,9 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - use grid point to read coordinates variable.
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
-   !> @date February, 2015
-   !> - use longitude or latitude as standard name, if can not find 
-   !> longitude_T, latitude_T...
    !>
    !> @param[in] td_longitude0   coarse grid longitude
@@ -2200,17 +2154,15 @@
 
       ! local variable
-      CHARACTER(LEN= 1)                        :: cl_point
-      CHARACTER(LEN=lc)                        :: cl_name
-
-      INTEGER(i4)                              :: il_ind
-
-      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
-
-      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
-
-      TYPE(TVAR)                               :: tl_lon1
-      TYPE(TVAR)                               :: tl_lat1
-
-      TYPE(TMPP)                               :: tl_coord1
+      TYPE(TMPP)  :: tl_coord1
+
+      TYPE(TVAR)  :: tl_lon1
+      TYPE(TVAR)  :: tl_lat1
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)       :: il_xghost
+
+      CHARACTER(LEN= 1) :: cl_point
+      CHARACTER(LEN=lc) :: cl_name
 
       ! loop indices
@@ -2257,21 +2209,6 @@
          ! read fine longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
-            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'longitude'
-         ENDIF
          tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
-
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
-            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'latitude'
-         ENDIF
          tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
          
@@ -2307,12 +2244,9 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - use grid point to read coordinates variable.
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
-   !> @date February, 2015
-   !> - use longitude or latitude as standard name, if can not find 
-   !> longitude_T, latitude_T...
    !> 
    !> @param[in] td_coord0 coarse grid coordinate mpp structure
@@ -2337,21 +2271,20 @@
 
       ! local variable
-      CHARACTER(LEN= 1)                        :: cl_point
-      CHARACTER(LEN=lc)                        :: cl_name      
-
-      INTEGER(i4)                              :: il_imin0
-      INTEGER(i4)                              :: il_imax0
-      INTEGER(i4)                              :: il_jmin0
-      INTEGER(i4)                              :: il_jmax0
-      INTEGER(i4)                              :: il_ind
-
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
-
-      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
-
-      TYPE(TVAR)                               :: tl_lon0
-      TYPE(TVAR)                               :: tl_lat0
-
-      TYPE(TMPP)                               :: tl_coord0
+      TYPE(TMPP)  :: tl_coord0
+
+      TYPE(TVAR)  :: tl_lon0
+      TYPE(TVAR)  :: tl_lat0
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)       :: il_xghost
+
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_jmax0
+
+      CHARACTER(LEN= 1) :: cl_point
+      CHARACTER(LEN=lc) :: cl_name      
 
       ! loop indices
@@ -2397,21 +2330,6 @@
          ! read coarse longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
-            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'longitude'
-         ENDIF
          tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
-         
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
-            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
-            &  try to use latitude.")
-            WRITE(cl_name,*) 'latitude'
-         ENDIF
          tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
 
@@ -2459,5 +2377,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - check grid point
@@ -2602,5 +2520,5 @@
             CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
             CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
- 
+            
             ! "global" coarse grid indice
             il_imin0=1
@@ -2650,10 +2568,4 @@
             IF( dl_lon1_ll == tl_lon1%d_fill .OR. &
             &   dl_lat1_ll == tl_lat1%d_fill )THEN
-               CALL logger_debug("GRID GET COARSE INDEX: lon "//&
-               &  TRIM(fct_str(dl_lon1_ll))//" "//&
-               &  TRIM(fct_str(tl_lon1%d_fill)) )
-               CALL logger_debug("GRID GET COARSE INDEX: lat "//&
-               &  TRIM(fct_str(dl_lat1_ll))//" "//&
-               &  TRIM(fct_str(tl_lat1%d_fill)) )
                CALL logger_error("GRID GET COARSE INDEX: lower left corner "//&
                &                 "point is FillValue. remove ghost cell "//&
@@ -2720,4 +2632,5 @@
             ji = il_iul(1)
             jj = il_iul(2)
+
             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN
                IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN
@@ -2734,4 +2647,5 @@
                ENDIF
             ENDIF
+
             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN
                IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN
@@ -2884,5 +2798,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_lon longitude structure 
@@ -2952,6 +2866,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 - change dichotomy method to manage ORCA grid
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_lon0   coarse grid array of longitude
@@ -2959,8 +2872,8 @@
    !> @param[in] dd_lon1   fine   grid longitude
    !> @param[in] dd_lat1   fine   grid latitude
-   !> @param[in] dd_fill   fill value
    !> @return coarse grid indices of closest point of fine grid point
-   !-------------------------------------------------------------------
-   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill )
+   !>
+   !-------------------------------------------------------------------
+   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1  )
       IMPLICIT NONE
       ! Argument
@@ -2969,5 +2882,4 @@
       REAL(dp),                 INTENT(IN) :: dd_lon1
       REAL(dp),                 INTENT(IN) :: dd_lat1
-      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
 
       ! function
@@ -3017,38 +2929,50 @@
 
       ll_north=.FALSE.
-      ll_continue=.FALSE.
-
-      ! avoid to use fillvalue for reduce domain on first time
-      IF( PRESENT(dd_fill) )THEN
-         DO WHILE( ALL(dl_lon0(il_isup,:) == dd_fill) )
-            il_isup=il_isup-1
-         ENDDO
-         DO WHILE( ALL(dl_lon0(il_iinf,:) == dd_fill) )
-            il_iinf=il_iinf+1
-         ENDDO
-         DO WHILE( ALL(dd_lat0(:,il_jsup) == dd_fill) )
-            il_jsup=il_jsup-1
-         ENDDO
-         DO WHILE( ALL(dd_lat0(:,il_jinf) == dd_fill) )
-            il_jinf=il_jinf+1
-         ENDDO
+      ll_continue=.TRUE.
+
+      ! look for meridian 0°/360°
+      il_jmid = il_jinf + INT(il_shape(2)/2)
+      il_ind(:) = MAXLOC( dl_lon0(:,il_jmid), dl_lon0(:,il_jmid) <= 360._dp )
+
+      il_imid=il_ind(1)
+
+      IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
+      &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
+
+         il_iinf = il_imid ;  il_isup = il_imid
+         il_jinf = il_jmid ;  il_jsup = il_jmid
+
+         ll_continue=.FALSE.
+
+      ELSE
+         IF( dl_lon1 < dl_lon0(il_isup,il_jmid) .AND. &
+         &   il_imid /= il_isup )THEN
+
+            ! point east
+            il_iinf = il_imid
+      
+         ELSE IF( dl_lon1 > dl_lon0(il_iinf,il_jmid) .AND. &
+         &        il_imid /= il_iinf )THEN
+
+            ! point west
+            il_isup = il_imid
+
+         ENDIF
 
          il_shape(1)= il_isup - il_iinf + 1
          il_shape(2)= il_jsup - il_jinf + 1
 
-      ENDIF
-
-      ! special case for north ORCA grid
-      IF( dd_lat1 > 19. .AND. dl_lon1 < 74.  )THEN
-         ll_north=.TRUE.
-      ENDIF
-
-      IF( .NOT. ll_north )THEN
-         ! look for meridian 0°/360°
+         il_imid = il_iinf + INT(il_shape(1)/2) 
          il_jmid = il_jinf + INT(il_shape(2)/2)
-         il_ind(:) = MAXLOC( dl_lon0(il_iinf:il_isup,il_jmid), &
-         &                   dl_lon0(il_iinf:il_isup,il_jmid) <= 360._dp )
-
-         il_imid=il_ind(1)
+
+         ! exit if too close from north fold (safer)
+         IF( dd_lat0(il_imid,il_jmid) > 50.0 ) ll_north=.TRUE.
+
+         ! exit when close enough of point
+         IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
+      ENDIF
+
+      !
+      DO WHILE( ll_continue .AND. .NOT. ll_north )
 
          IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
@@ -3058,68 +2982,28 @@
             il_jinf = il_jmid ;  il_jsup = il_jmid
 
+            ll_continue=.FALSE.
+
          ELSE
-            IF( ALL(dl_lon0(il_isup,il_jinf:il_jsup) >  dl_lon1 ) .AND. &
-            &   il_imid /= il_isup )THEN
-               ! 0 < lon1 < lon0(isup)
+            IF( dl_lon1 > dl_lon0(il_imid,il_jmid) )THEN
+
                ! point east
-               il_iinf = il_imid+1
-               ll_continue=.TRUE.
-         
-            ELSE IF( ALL(dl_lon0(il_iinf,il_jinf:il_jsup) <  dl_lon1 ) .AND. &
-            &        il_imid /= il_iinf )THEN
-               ! lon0(iinf) < lon1 < 360
+               il_iinf = il_imid
+        
+            ELSE IF(dl_lon1 < dl_lon0(il_imid,il_jmid) )THEN
+
                ! point west
                il_isup = il_imid
-               ll_continue=.TRUE.
 
             ENDIF
 
-            il_shape(1)= il_isup - il_iinf + 1
-            il_shape(2)= il_jsup - il_jinf + 1
-
-            il_imid = il_iinf + INT(il_shape(1)/2) 
-            il_jmid = il_jinf + INT(il_shape(2)/2)
-
-            ! exit when close enough of point
-            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
-         ENDIF
-      ENDIF
-
-      !
-      DO WHILE( ll_continue .AND. .NOT. ll_north )
-
-         ll_continue=.FALSE.
-         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
-         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
-
-            il_iinf = il_imid ;  il_isup = il_imid
-            il_jinf = il_jmid ;  il_jsup = il_jmid
-
-         ELSE
-            IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN    
-
-               ! point east
-               il_iinf = il_imid
-               ll_continue=.TRUE.
-        
-            ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) >  dl_lon1) )THEN    
-
-               ! point west
-               il_isup = il_imid
-               ll_continue=.TRUE.
-
-            ENDIF
-
-            IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN    
+            IF( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN
                
                ! point north
                il_jinf = il_jmid
-               ll_continue=.TRUE.
-
-            ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN    
+
+            ELSE IF(dd_lat1 < dd_lat0(il_imid,il_jmid) )THEN
 
                ! point south
                il_jsup = il_jmid
-               ll_continue=.TRUE.
             
             ENDIF
@@ -3130,4 +3014,7 @@
             il_imid = il_iinf + INT(il_shape(1)/2) 
             il_jmid = il_jinf + INT(il_shape(2)/2)
+
+            ! exit if too close from north fold (safer)
+            IF( dd_lat0(il_imid,il_jmid) > 50.0 ) ll_north=.TRUE.
 
             ! exit when close enough of point
@@ -3162,5 +3049,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_lon    grid longitude array
@@ -3168,8 +3055,7 @@
    !> @param[in] dd_lonA   longitude of point A
    !> @param[in] dd_latA   latitude  of point A
-   !> @param[in] dd_fill
    !> @return array of distance between point A and grid points.
    !-------------------------------------------------------------------
-   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA )
+   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA)
       IMPLICIT NONE
       ! Argument      
@@ -3224,10 +3110,9 @@
          DO ji=1,il_shape(1)
             IF( dl_lon(ji,jj) == dl_lonA .AND. &
-            &   dl_lat(ji,jj) == dl_latA )THEN
+            &   dl_lat(ji,jj) == dl_laTA )THEN
                grid_distance(ji,jj)=0.0
             ELSE
                dl_tmp= SIN(dl_latA)*SIN(dl_lat(ji,jj)) + &
-               &       COS(dl_latA)*COS(dl_lat(ji,jj)) * &
-               &       COS(dl_lon(ji,jj)-dl_lonA)
+               &       COS(dl_latA)*COS(dl_lat(ji,jj))*COS(dl_lon(ji,jj)-dl_lonA)
                ! check to avoid mistake with ACOS
                IF( dl_tmp < -1.0 ) dl_tmp = -1.0
@@ -3251,5 +3136,5 @@
    !
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3285,17 +3170,16 @@
 
       ! local variable
-      INTEGER(i4)                              :: il_imin0
-      INTEGER(i4)                              :: il_jmin0
-      INTEGER(i4)                              :: il_imax0
-      INTEGER(i4)                              :: il_jmax0
-      INTEGER(i4)                              :: il_ind
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmax0
       
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
       
-      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
-      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
-
-      CHARACTER(LEN= 1)                        :: cl_point
-      CHARACTER(LEN=lc)                        :: cl_name
+      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1
+
+      CHARACTER(LEN= 1) :: cl_point
+      CHARACTER(LEN=lc) :: cl_name
 
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
@@ -3304,11 +3188,11 @@
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
 
-      TYPE(TVAR)                               :: tl_lon0
-      TYPE(TVAR)                               :: tl_lat0
-      TYPE(TVAR)                               :: tl_lon1
-      TYPE(TVAR)                               :: tl_lat1
-
-      TYPE(TMPP)                               :: tl_coord0
-      TYPE(TMPP)                               :: tl_coord1
+      TYPE(TVAR) :: tl_lon0
+      TYPE(TVAR) :: tl_lat0
+      TYPE(TVAR) :: tl_lon1
+      TYPE(TVAR) :: tl_lat1
+
+      TYPE(TMPP) :: tl_coord0
+      TYPE(TMPP) :: tl_coord1
       
       ! loop indices
@@ -3343,21 +3227,6 @@
          ! read coarse longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'longitude'
-         ENDIF
          tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
-
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
-            &  try to use latitude.")
-            WRITE(cl_name,*) 'latitude'
-         ENDIF
          tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
          
@@ -3398,21 +3267,6 @@
          ! read fine longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'longitude'
-         ENDIF
          tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
-
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
-            &  try to use latitude.")
-            WRITE(cl_name,*) 'latitude'
-         ENDIF
          tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
  
@@ -3464,5 +3318,5 @@
    !
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3500,18 +3354,18 @@
 
       ! local variable
-      INTEGER(i4)                              :: il_ind
-      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
       
-      CHARACTER(LEN= 1)                        :: cl_point
-      CHARACTER(LEN=lc)                        :: cl_name
+      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1
+
+      CHARACTER(LEN= 1) :: cl_point
+      CHARACTER(LEN=lc) :: cl_name
 
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
 
-      TYPE(TVAR)                               :: tl_lon1
-      TYPE(TVAR)                               :: tl_lat1
-
-      TYPE(TMPP)                               :: tl_coord1
+      TYPE(TVAR) :: tl_lon1
+      TYPE(TVAR) :: tl_lat1
+
+      TYPE(TMPP) :: tl_coord1
       ! loop indices
       !----------------------------------------------------------------
@@ -3543,21 +3397,6 @@
          ! read fine longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'longitude'
-         ENDIF
          tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
-
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
-            &  try to use latitude.")
-            WRITE(cl_name,*) 'latitude'
-         ENDIF
          tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
  
@@ -3607,5 +3446,5 @@
    !
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3644,24 +3483,23 @@
 
       ! local variable
-      INTEGER(i4)                              :: il_imin0
-      INTEGER(i4)                              :: il_jmin0
-      INTEGER(i4)                              :: il_imax0
-      INTEGER(i4)                              :: il_jmax0
-      INTEGER(i4)                              :: il_ind
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmax0
       
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
       
-      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
-
-      CHARACTER(LEN= 1)                        :: cl_point
-      CHARACTER(LEN=lc)                        :: cl_name
+      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0
+
+      CHARACTER(LEN= 1) :: cl_point
+      CHARACTER(LEN=lc) :: cl_name
 
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
 
-      TYPE(TVAR)                               :: tl_lon0
-      TYPE(TVAR)                               :: tl_lat0
-
-      TYPE(TMPP)                               :: tl_coord0
+      TYPE(TVAR) :: tl_lon0
+      TYPE(TVAR) :: tl_lat0
+
+      TYPE(TMPP) :: tl_coord0
       ! loop indices
       !----------------------------------------------------------------
@@ -3692,21 +3530,6 @@
          ! read coarse longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
-            &  try to use longitude.")
-            WRITE(cl_name,*) 'longitude'
-         ENDIF
          tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
-
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
-         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
-         IF( il_ind == 0 )THEN
-            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
-            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
-            &  try to use latitude.")
-            WRITE(cl_name,*) 'latitude'
-         ENDIF
          tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
          
@@ -3762,10 +3585,7 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date September, 2014 
-   !> - rename from grid_get_fine_offset
-   !> @date May, 2015 
-   !> - improve way to find offset
-   !>
+   !> - November, 2013 - Initial Version
+   !> @date September, 2014 - rename from grid_get_fine_offset
+   !
    !> @param[in] dd_lon0   coarse grid longitude array 
    !> @param[in] dd_lat0   coarse grid latitude  array
@@ -3800,12 +3620,8 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(2)                :: il_shape0
-      INTEGER(i4), DIMENSION(2)                :: il_shape1
-
+      INTEGER(i4), DIMENSION(2) :: il_shape0
+      INTEGER(i4), DIMENSION(2) :: il_shape1
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
-
-      LOGICAL                                  :: ll_ii
-      LOGICAL                                  :: ll_ij
       
       ! loop indices
@@ -3841,14 +3657,11 @@
       grid__get_fine_offset_cc(:,:)=-1
 
-      IF( il_shape1(jp_J) == 1 )THEN
-          
-         grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2)
-
-         ! work on i-direction
-         ! look for i-direction left offset
+      IF( il_shape1(1) > 1 )THEN
+
+         ! look for i-direction left offset 
          IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN
             DO ji=1,id_rho(jp_I)+2
                IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN
-                  grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji
+                  grid__get_fine_offset_cc(1,1)=(id_rho(jp_I)+1)-ji
                   EXIT
                ENDIF
@@ -3858,10 +3671,11 @@
             &                 " not match fine grid lower left corner.")
          ENDIF
+
          ! look for i-direction right offset
-         IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN
+         IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN
             DO ji=1,id_rho(jp_I)+2
-               ii=il_shape1(jp_I)-ji+1
+               ii=il_shape1(1)-ji+1
                IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN
-                  grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji
+                  grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji
                   EXIT
                ENDIF
@@ -3872,9 +3686,9 @@
          ENDIF
 
-      ELSEIF( il_shape1(jp_I) == 1 )THEN
-         
-         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2)
-         
-         ! work on j-direction
+      ELSE
+         grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2)
+      ENDIF
+
+      IF( il_shape1(2) > 1 )THEN
 
          ! look for j-direction lower offset 
@@ -3882,5 +3696,5 @@
             DO jj=1,id_rho(jp_J)+2
                IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN
-                  grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj
+                  grid__get_fine_offset_cc(2,1)=(id_rho(jp_J)+1)-jj
                   EXIT
                ENDIF
@@ -3892,9 +3706,9 @@
 
          ! look for j-direction upper offset 
-         IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN
+         IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN
             DO jj=1,id_rho(jp_J)+2
-               ij=il_shape1(jp_J)-jj+1
+               ij=il_shape1(2)-jj+1
                IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN
-                  grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj
+                  grid__get_fine_offset_cc(2,2)=(id_rho(jp_J)+1)-jj
                   EXIT
                ENDIF
@@ -3903,81 +3717,7 @@
             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
             &                 " not match fine grid upper right corner.")
-         ENDIF         
-
-      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1 
-
-         ! look for lower left offset
-         IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0+1) )THEN
-
-            ii=1
-            ij=1
-            DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2)
-
-               ll_ii=.FALSE.
-               ll_ij=.FALSE.
-
-               IF( dl_lon1(ii,ij) >= dl_lon0(id_imin0+1,id_jmin0+1)-dp_delta .AND. &
-               &   dd_lat1(ii,ij) >= dd_lat0(id_imin0+1,id_jmin0+1)-dp_delta )THEN
-                  grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
-                  grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij
-                  EXIT
-               ENDIF
-
-               IF( dl_lon1(ii+1,ij) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. &
-               &   dd_lat1(ii+1,ij) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN
-                  ll_ii=.TRUE.
-               ENDIF
-               IF( dl_lon1(ii,ij+1) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. &
-               &   dd_lat1(ii,ij+1) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN
-                  ll_ij=.TRUE.
-               ENDIF
-
-               IF( ll_ii ) ii=ii+1
-               IF( ll_ij ) ij=ij+1
-
-            ENDDO
-
-         ELSE
-            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
-            &                 " not match fine grid lower left corner.")
          ENDIF
-
-         ! look for upper right offset
-         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > &
-            & dl_lon0(id_imax0-1,id_jmax0-1) )THEN
-
-            ii=il_shape1(jp_I)
-            ij=il_shape1(jp_J)
-            DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2)
-
-               ll_ii=.FALSE.
-               ll_ij=.FALSE.
-
-               IF( dl_lon1(ii,ij) <= dl_lon0(id_imax0-1,id_jmax0-1)+dp_delta .AND. &
-               &   dd_lat1(ii,ij) <= dd_lat0(id_imax0-1,id_jmax0-1)+dp_delta )THEN
-                  grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-(il_shape1(jp_I)+1-ii)
-                  grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-(il_shape1(jp_J)+1-ij)
-                  EXIT
-               ENDIF
-
-               IF( dl_lon1(ii-1,ij) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. &
-               &   dd_lat1(ii-1,ij) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN
-                  ll_ii=.TRUE.
-               ENDIF
-               IF( dl_lon1(ii,ij-1) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. &
-               &   dd_lat1(ii,ij-1) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN
-                  ll_ij=.TRUE.
-               ENDIF
-
-               IF( ll_ii ) ii=ii-1
-               IF( ll_ij ) ij=ij-1
-
-            ENDDO
-
-         ELSE
-            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
-            &                 " not match fine grid upper right corner.")
-         ENDIF
-
+      ELSE
+         grid__get_fine_offset_cc(2,:)=((id_rho(jp_J)-1)/2)
       ENDIF
 
@@ -3992,5 +3732,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013- Initial Version
+   !> - November, 2013- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -4002,5 +3742,5 @@
    !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain 
    !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain  
-   !> @param[in] id_rho    array of refinement factor 
+   !> @param[in] id_rho    array of refinement factor (default 1) 
    !-------------------------------------------------------------------
    SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, &
@@ -4302,5 +4042,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_lon0   array of coarse grid longitude
@@ -4363,4 +4103,5 @@
       dl_lon1 = dd_lon1(il_imin1, il_jmin1)
       dl_lat1 = dd_lat1(il_imin1, il_jmin1)
+
 
       IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. & 
@@ -4461,5 +4202,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] dd_lat0   array of coarse grid latitude 
@@ -4531,5 +4272,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013-Initial version
    !
    !> @param[inout] td_var array of variable structure 
@@ -4607,5 +4348,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> - November, 2013-Initial version
    !
    !> @param[inout] td_var array of variable structure 
@@ -4633,8 +4374,6 @@
       IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
 
-         IF( ANY(id_ghost(:,:)/=0) )THEN
-            CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
-            &              TRIM(td_var%c_name) )
-         ENDIF
+         CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
+         &              TRIM(td_var%c_name) )
 
          ! copy variable
@@ -4686,5 +4425,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !
    !> @param[in] td_var variable sturcture 
@@ -4816,5 +4555,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -4853,5 +4592,4 @@
           tl_mpp=mpp_copy(td_mpp)
 
-          CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio)))
           IF( tl_mpp%i_perio < 0 )THEN
              ! compute NEMO periodicity index
@@ -4889,5 +4627,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var    variable strucutre 
@@ -4956,5 +4694,4 @@
                         il_tmp(jim:jip,jjm:jjp)=1
                      END WHERE
-
                   ENDIF
                ENDDO
@@ -4983,10 +4720,10 @@
    !>
    !> @details
-   !> the minimum size (number of point) of closed sea to be kept could be
+   !> the minimum size (nbumber of point) of closed sea to be kept could be
    !> sepcify with id_minsize.
    !> By default only the biggest sea is preserve.
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var    variable structure
@@ -5045,101 +4782,4 @@
 
    END SUBROUTINE grid_fill_small_dom
-   !-------------------------------------------------------------------
-   !> @brief This subroutine fill small domain inside bigger one. 
-   !>
-   !> @details
-   !> the minimum size (number of point) of domain sea to be kept could be
-   !> is sepcified with id_minsize.
-   !> smaller domain are included in the one they are embedded.
-   !>
-   !> @author J.Paul
-   !> @date Ferbruay, 2015 - Initial Version
-   !>
-   !> @param[inout] id_mask      domain mask (from grid_split_domain)
-   !> @param[in] id_minsize   minimum size of sea to be kept
-   !-------------------------------------------------------------------
-   SUBROUTINE grid_fill_small_msk(id_mask, id_minsize)
-      IMPLICIT NONE
-      ! Argument      
-      INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mask
-      INTEGER(i4),                 INTENT(IN   ) :: id_minsize
-
-      ! local variable
-      INTEGER(i4)                              :: il_ndom
-      INTEGER(i4)                              :: il_minsize
-      INTEGER(i4)                              :: il_msk
-      
-      INTEGER(i4)                              :: jim
-      INTEGER(i4)                              :: jjm
-      INTEGER(i4)                              :: jip
-      INTEGER(i4)                              :: jjp
-
-      INTEGER(i4), DIMENSION(2)                :: il_shape
-      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
-
-      ! loop indices
-      INTEGER(i4) :: ii
-      INTEGER(i4) :: ij
-
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
-      !----------------------------------------------------------------
-
-      il_shape(:)=SHAPE(id_mask(:,:))
-      il_ndom=MINVAL(id_mask(:,:))
-
-      ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
-      il_tmp(:,:)=0
-      DO ji=-1,il_ndom,-1
-         WHERE( id_mask(:,:)==ji ) 
-            il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
-         END WHERE
-      ENDDO
-
-      DO WHILE( id_minsize > MINVAL(il_tmp(:,:)) )
-
-         DO jj=1,il_shape(2)
-            DO ji=1,il_shape(1)
-
-               IF( il_tmp(ji,jj) < il_minsize )THEN
-                  jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1)
-                  jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1)
-                  
-                  il_msk=0
-                  DO ij=jjm,jjp
-                     DO ii=jim,jip
-                        IF( id_mask(ii,ij) /= id_mask(ji,jj) )THEN
-                           IF( il_msk == 0 )THEN
-                              il_msk=id_mask(ii,ij)
-                           ELSEIF( il_msk /= id_mask(ii,ij) )THEN
-                              CALL logger_error("GRID FILL SMALL MSK: "//&
-                              &  "small domain not embedded in bigger one"//&
-                              &  ". point should be between two different"//&
-                              &  " domain.")
-                           ENDIF
-                        ENDIF
-                     ENDDO
-                  ENDDO
-                  IF( il_msk /= 0 ) id_mask(ji,jj)=il_msk
-
-               ENDIF
-
-            ENDDO
-         ENDDO
-
-
-         il_tmp(:,:)=0
-         DO ji=-1,il_ndom,-1
-            WHERE( id_mask(:,:)==ji ) 
-               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
-            END WHERE
-         ENDDO            
-
-      ENDDO
-
-      DEALLOCATE( il_tmp )
-
-
-   END SUBROUTINE grid_fill_small_msk
 END MODULE grid
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 10251)
@@ -27,5 +27,5 @@
 !>    defining string character _cn\_varinfo_.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:int=cubic/rhoi', 'varname2:int=linear' 
+!>       - cn_varinfo='varname1:cubic/rhoi', 'varname2:linear' 
 !>
 !>    to create mixed grid (with coarse grid point needed to compute
@@ -137,5 +137,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_method interpolation method
@@ -179,5 +179,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_mix mixed grid variable (to interpolate)
@@ -244,5 +244,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_mix mixed grid variable (to interpolate)
@@ -363,5 +363,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_var    coarse grid variable (should be extrapolated)
@@ -449,5 +449,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_mix mixed grid variable
@@ -610,5 +610,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - use offset to save useful domain
@@ -716,5 +716,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -828,5 +828,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - use interpolation method modules
@@ -947,5 +947,4 @@
 
       DEALLOCATE(il_detect)
-
       !4- save useful domain (remove offset)
       CALL interp_clean_mixed_grid( tl_mix, td_var, &
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 10251)
@@ -26,6 +26,4 @@
 ! REVISION HISTORY:
 !> @date September, 2014 -Initial version
-!> @date June, 2015
-!> - use math module
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -38,5 +36,5 @@
    USE logger                          ! log file manager
    USE fct                             ! basic useful function
-   USE math                            ! mathematical function
+   USE extrap                          ! extrapolation manager
 
    IMPLICIT NONE
@@ -63,7 +61,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
-   !> @date July, 2015 
-   !> - reinitialise detect array for each level
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -86,13 +82,11 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(4)                  :: il_shape
-
-      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
-
-      LOGICAL                                    :: ll_discont
-
-      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ
-      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I
-      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J
+      INTEGER(i4), DIMENSION(4)                :: il_shape
+
+      LOGICAL                                  :: ll_discont
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_IJ
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_I
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_J
       
       ! loop indices
@@ -119,8 +113,5 @@
       &                               id_rho(jp_J), ld_even(jp_J))
 
-      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
-
       DO jl=1,il_shape(4)
-         il_detect(:,:,:)=id_detect(:,:,:)
          ! loop on vertical level
          DO jk=1,il_shape(3)
@@ -128,17 +119,17 @@
             ! I-J plan
             CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, &
-            &                     il_detect(:,:,jk),            &
+            &                     id_detect(:,:,jk),            &
             &                     dl_weight_IJ(:,:),            &
             &                     id_rho(jp_I), id_rho(jp_J),   &
             &                     ll_discont)            
-            IF( ANY(il_detect(:,:,jk)==1) )THEN
+            IF( ANY(id_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, &
-                  &                      il_detect(:,jj,jk),            &
+                  &                      id_detect(:,jj,jk),            &
                   &                      dl_weight_I(:,:),              &
                   &                      id_rho(jp_I), ll_discont )
                ENDDO
-               IF( ALL(il_detect(:,:,jk)==0) )THEN
+               IF( ALL(id_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -146,5 +137,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, &
-                     &                      il_detect(ji,:,jk),            &
+                     &                      id_detect(ji,:,jk),            &
                      &                      dl_weight_J(:,:),              &
                      &                      id_rho(jp_J), ll_discont )
@@ -156,7 +147,4 @@
       ENDDO
 
-      id_detect(:,:,:)=il_detect(:,:,:)
-      DEALLOCATE(il_detect)
-
       DEALLOCATE(dl_weight_IJ)
       DEALLOCATE(dl_weight_I)
@@ -171,5 +159,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -193,5 +181,5 @@
       REAL(dp)                        , INTENT(IN   ) :: dd_fill 
       INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
-      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
       INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
       INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj
@@ -242,9 +230,9 @@
 
          ! compute derivative on coarse grid
-         dl_dfdx(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)
-         dl_dfdy(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)
+         dl_dfdx(:,:)=extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)
+         dl_dfdy(:,:)=extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)
 
          ! compute cross derivative on coarse grid
-         dl_d2fdxy(:,:)=math_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)
+         dl_d2fdxy(:,:)=extrap_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)
 
          ALLOCATE( dl_tmp(2,2) )
@@ -331,5 +319,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -351,5 +339,5 @@
       REAL(dp)                        , INTENT(IN   ) :: dd_fill 
       INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
-      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
       INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
       LOGICAL                         , INTENT(IN   ) :: ld_discont
@@ -388,5 +376,5 @@
 
          ! compute derivative on coarse grid
-         dl_dfdx(:)=math_deriv_1D(dl_coarse(:), dd_fill, ld_discont)
+         dl_dfdx(:)=extrap_deriv_1D(dl_coarse(:), dd_fill, ld_discont)
 
          ALLOCATE( dl_tmp(2) )
@@ -452,5 +440,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] dd_value  2D array of value
@@ -515,5 +503,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  2D array of mixed grid value
@@ -577,5 +565,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] dd_value  1D array of value
@@ -620,5 +608,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  1D array of mixed grid value
@@ -671,5 +659,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 2D array
@@ -752,5 +740,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 1D array
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 10251)
@@ -24,5 +24,5 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date September, 2014 - Initial version
+!> @date September, 2014 -Initial version
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -63,6 +63,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
-   !> @date July, 2015 - reinitialise detect array for each level
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -85,13 +84,11 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(4)                  :: il_shape
-
-      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
-
-      LOGICAL                                    :: ll_discont
- 
-      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ
-      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I
-      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J
+      INTEGER(i4), DIMENSION(4)                :: il_shape
+
+      LOGICAL                                  :: ll_discont
+      
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_IJ
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_I
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_J
       
       ! loop indices
@@ -107,10 +104,10 @@
 
       ! compute vect2D
-      ALLOCATE(dl_weight_IJ(4,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
+      ALLOCATE(dl_weight_IJ(16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
       CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), &
       &                               id_rho(:), ld_even(:))
 
-      ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1)                 )) )
-      ALLOCATE( dl_weight_J( 2,(                 (id_rho(jp_J)+1))) )
+      ALLOCATE( dl_weight_I( 4,((id_rho(jp_I)+1)                 )) )
+      ALLOCATE( dl_weight_J( 4,(                 (id_rho(jp_J)+1))) )
       CALL interp_linear__get_weight1D(dl_weight_I(:,:), &
       &                               id_rho(jp_I), ld_even(jp_I))
@@ -118,8 +115,5 @@
       &                               id_rho(jp_J), ld_even(jp_J))
 
-      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
-
       DO jl=1,il_shape(4)
-         il_detect(:,:,:)=id_detect(:,:,:)
          ! loop on vertical level
          DO jk=1,il_shape(3)
@@ -127,17 +121,17 @@
             ! I-J plan
             CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,&
-            &                     il_detect(:,:,jk),            &
+            &                     id_detect(:,:,jk),            &
             &                     dl_weight_IJ(:,:),            &
             &                     id_rho(jp_I), id_rho(jp_J),   &
             &                     ll_discont)            
-            IF( ANY(il_detect(:,:,jk)==1) )THEN
+            IF( ANY(id_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,&
-                  &                       il_detect(:,jj,jk),           &
+                  &                       id_detect(:,jj,jk),           &
                   &                       dl_weight_I(:,:),             &
                   &                       id_rho(jp_I), ll_discont )
                ENDDO
-               IF( ALL(il_detect(:,:,jk)==0) )THEN
+               IF( ALL(id_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -145,5 +139,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,&
-                     &                       il_detect(ji,:,jk),           &
+                     &                       id_detect(ji,:,jk),           &
                      &                       dl_weight_J(:,:),             &
                      &                       id_rho(jp_J), ll_discont )
@@ -155,11 +149,8 @@
       ENDDO
 
-      id_detect(:,:,:)=il_detect(:,:,:)
-      DEALLOCATE(il_detect)
-
       DEALLOCATE(dl_weight_IJ)
       DEALLOCATE(dl_weight_I)
       DEALLOCATE(dl_weight_J)
- 
+      
    END SUBROUTINE interp_linear_fill
    !-------------------------------------------------------------------
@@ -170,5 +161,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -244,5 +235,5 @@
                IF( ALL(id_detect(ji:ji+id_rhoi,   &
                &                 jj:jj+id_rhoj)==0) ) CYCLE
-               ! check data needed to interpolate
+               ! check data to needed to interpolate
                IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE
                ! check longitude discontinuity
@@ -305,5 +296,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -417,5 +408,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] dd_value  2D array of value
@@ -454,6 +445,6 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
-   !>
+   !> - September, 2014- Initial Version
+   !> 
    !> @param[inout] dd_value  2D array of mixed grid value
    !> @param[inout] id_detect 2D array of point to be interpolated
@@ -486,25 +477,25 @@
       !----------------------------------------------------------------
 
-      IF( ANY( dd_coef(:)==dd_fill ) )THEN
-         CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//&
-         &              "can not compute interpolation.")
-      ELSE
-
-         ii=0
-         DO jj=1,id_rhoj+1
-            DO ji=1,id_rhoi+1
-
-               ii=ii+1
-               IF(id_detect(ji,jj)==1)THEN
-
-                  dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii))
-                  id_detect(ji,jj)=0
-
-               ENDIF
-
+         IF( ANY( dd_coef(:)==dd_fill ) )THEN
+            CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//&
+            &              "can not compute interpolation.")
+         ELSE
+
+            ii=0
+            DO jj=1,id_rhoj+1
+               DO ji=1,id_rhoi+1
+
+                  ii=ii+1
+                  IF(id_detect(ji,jj)==1)THEN
+
+                     dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii))
+                     id_detect(ji,jj)=0
+
+                  ENDIF
+
+               ENDDO
             ENDDO
-         ENDDO
-
-      ENDIF
+
+         ENDIF
 
    END SUBROUTINE interp_linear__2D_fill
@@ -514,5 +505,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] dd_value  1D array of value
@@ -549,5 +540,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !> 
    !> @param[inout] dd_value  1D array of mixed grid value
@@ -600,5 +591,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 2D array
@@ -669,5 +660,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 1D array
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 10251)
@@ -24,5 +24,5 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date September, 2014 - Initial version
+!> @date September, 2014 -Initial version
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -55,5 +55,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -69,7 +69,5 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(4)                  :: il_shape
-
-      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+      INTEGER(i4), DIMENSION(4)                :: il_shape
 
       ! loop indices
@@ -82,7 +80,5 @@
       il_shape(:)=SHAPE(dd_value)
 
-      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
       DO jl=1,il_shape(4)
-         il_detect(:,:,:)=id_detect(:,:,:)
          ! loop on vertical level
          DO jk=1,il_shape(3)
@@ -90,14 +86,14 @@
             ! I-J plan
             CALL interp_nearest__2D(dd_value(:,:,jk,jl),&
-            &                       il_detect(:,:,jk),  &
+            &                       id_detect(:,:,jk),  &
             &                       id_rho(jp_I), id_rho(jp_J) )            
-            IF( ANY(il_detect(:,:,jk)==1) )THEN
+            IF( ANY(id_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_nearest__1D( dd_value(:,jj,jk,jl),&
-                  &                        il_detect(:,jj,jk),  &
+                  &                        id_detect(:,jj,jk),  &
                   &                        id_rho(jp_I) )
                ENDDO
-               IF( ALL(il_detect(:,:,jk)==0) )THEN
+               IF( ALL(id_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -105,5 +101,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_nearest__1D( dd_value(ji,:,jk,jl),&
-                     &                        il_detect(ji,:,jk),  &
+                     &                        id_detect(ji,:,jk),  &
                      &                        id_rho(jp_J) )
                   ENDDO
@@ -114,7 +110,4 @@
       ENDDO
 
-      id_detect(:,:,:)=il_detect(:,:,:)
-      DEALLOCATE(il_detect)
-
    END SUBROUTINE interp_nearest_fill
    !-------------------------------------------------------------------
@@ -123,5 +116,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -178,5 +171,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -223,5 +216,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  2D array of mixed grid value
@@ -307,5 +300,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[inout] dd_value  1D array of mixed grid value
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 10251)
@@ -156,5 +156,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file file structure
@@ -186,5 +186,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file file structure
@@ -223,5 +223,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file file structure
@@ -252,5 +252,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file      file structure
@@ -300,5 +300,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -338,5 +338,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file      file structure
@@ -386,5 +386,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file      file structure
@@ -422,5 +422,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -452,5 +452,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -485,5 +485,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -529,5 +529,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -564,27 +564,21 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine write file structure in an opened file.
-   !>
-   !> @details
-   !> optionally, you could specify dimension order (default 'xyzt')
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 - add dimension order option
+   !
+   !> @author J.Paul
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
    !-------------------------------------------------------------------
-   SUBROUTINE iom_write_file(td_file, cd_dimorder)
-      IMPLICIT NONE
-      ! Argument      
-      TYPE(TFILE)     , INTENT(INOUT) :: td_file
-      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
-      !----------------------------------------------------------------
-
-      ! open file
-      SELECT CASE(TRIM(td_file%c_type))
-         CASE('cdf')
-            CALL iom_cdf_write_file(td_file, cd_dimorder)
-         CASE('dimg')
-            ! note: can not change dimension order in restart dimg file
+   SUBROUTINE iom_write_file(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_write_file(td_file)
+         CASE('dimg')
             CALL iom_rstdimg_write_file(td_file)
          CASE DEFAULT
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 10251)
@@ -144,24 +144,16 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date May, 2015 - add optional message to netcdf error message
-   !>
+   !> - November, 2013- Initial Version
+   !
    !> @param[in] id_status error status
-   !> @param[in] cd_msg    message
-   !-------------------------------------------------------------------
-   SUBROUTINE iom_cdf__check(id_status, cd_msg)
-      IMPLICIT NONE
-      ! Argument      
-      INTEGER(i4)     , INTENT(IN)           :: id_status
-      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_msg
-      ! local variable
-      CHARACTER(LEN=lc) :: cl_msg
-      !----------------------------------------------------------------
-
-      cl_msg=""
-      IF( PRESENT(cd_msg) ) cl_msg=cd_msg
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__check(id_status)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: id_status
+      !----------------------------------------------------------------
 
       IF( id_status /= NF90_NOERR )THEN
-         CALL logger_error(TRIM(cl_msg)//TRIM(NF90_STRERROR(id_status)))
+         CALL logger_error(TRIM(NF90_STRERROR(id_status)))
       ENDIF
 
@@ -181,5 +173,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -211,9 +203,8 @@
             CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) )
 
-            il_status = NF90_CREATE(TRIM(td_file%c_name),&
-            &                       cmode=NF90_64BIT_OFFSET,&
-            &                       ncid=td_file%i_id)
-         !NF90_WRITE,               &
-            CALL iom_cdf__check(il_status," IOM CDF CREATE: ")
+            il_status = NF90_CREATE( TRIM(td_file%c_name),&
+            &                        NF90_WRITE,               &
+            &                        td_file%i_id)
+            CALL iom_cdf__check(il_status)
 
             td_file%l_def=.TRUE.
@@ -237,8 +228,7 @@
                &                      NF90_NOWRITE,         &
                &                      td_file%i_id)
-               CALL iom_cdf__check(il_status," IOM CDF OPEN: ")
-
-               CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//&
-                  &  TRIM(fct_str(td_file%i_id)))
+               CALL iom_cdf__check(il_status)
+
+               CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//TRIM(fct_str(td_file%i_id)))
             ELSE
 
@@ -249,5 +239,5 @@
                &                      NF90_WRITE,           &
                &                      td_file%i_id)
-               CALL iom_cdf__check(il_status,"IOM CDF OPEN: ")
+               CALL iom_cdf__check(il_status)
 
             ENDIF
@@ -277,5 +267,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -301,5 +291,5 @@
 
          il_status = NF90_CLOSE(td_file%i_id)
-         CALL iom_cdf__check(il_status,"IOM CDF CLOSE: ")
+         CALL iom_cdf__check(il_status)
 
          td_file%i_id = 0
@@ -317,5 +307,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -336,5 +326,5 @@
       il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, &
       &     td_file%i_nvar, td_file%i_natt, td_file%i_uldid, il_fmt)
-      CALL iom_cdf__check(il_status,"IOM CDF GET INFO: ")
+      CALL iom_cdf__check(il_status)
 
       SELECT CASE(il_fmt)
@@ -355,5 +345,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -406,5 +396,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - use attribute periodicity read from the file if present.
@@ -449,5 +439,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -490,12 +480,12 @@
 
             ! look for depth id
-            IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'depth')/=0 )THEN
+            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'depth') /= 0 )THEN
                IF( td_file%i_depthid == 0 )THEN
                   td_file%i_depthid=ji
                ELSE
                   IF( td_file%i_depthid /= ji )THEN
-                     CALL logger_error("IOM CDF GET FILE VAR: find more"//&
-                        &  " than one depth variable in file "//&
-                        &  TRIM(td_file%c_name) )
+                     CALL logger_error("IOM CDF GET FILE VAR: find more than one "//&
+                     &                 "depth variable in file "//&
+                     &                 TRIM(td_file%c_name) )
                   ENDIF
                ENDIF
@@ -503,5 +493,5 @@
 
             ! look for time id
-            IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'time')/=0 )THEN
+            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'time') /= 0 )THEN
                IF( td_file%i_timeid == 0 )THEN
                   td_file%i_timeid=ji
@@ -514,6 +504,7 @@
                      td_file%i_timeid=ji
                   !ELSE
-                  !   CALL logger_error("IOM CDF GET FILE VAR: find more "//&
-                  !   &                 "than one time variable in file "//&
+                  !   print *,'error'
+                  !   CALL logger_error("IOM OPEN: find more than one "//&
+                  !   &                 "time variable in file "//&
                   !   &                 TRIM(td_file%c_name) )
                   ENDIF
@@ -535,5 +526,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -576,7 +567,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 - create unused dimension, when reading dimension
-   !> of length less or equal to zero
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -594,5 +583,4 @@
       INTEGER(i4)       :: il_len
       CHARACTER(LEN=lc) :: cl_name
-      LOGICAL           :: ll_use
       !----------------------------------------------------------------
 
@@ -613,15 +601,7 @@
          il_status=NF90_INQUIRE_DIMENSION(td_file%i_id, id_dimid, &
          &                                cl_name, il_len )
-         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
-
-         ll_use=.TRUE.
-         IF( il_len <= 0 )THEN
-            CALL logger_warn( &
-         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
-         &  " in file "//TRIM(td_file%c_name)//" is less or equel to zero")
-            il_len=1
-            ll_use=.FALSE.
-         ENDIF
-         iom_cdf__read_dim_id=dim_init(cl_name, il_len, ld_use=ll_use)
+         CALL iom_cdf__check(il_status)
+
+         iom_cdf__read_dim_id=dim_init(cl_name, il_len)
 
       ENDIF
@@ -633,5 +613,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -654,6 +634,5 @@
 
          CALL logger_error( &
-         &  " IOM CDF READ DIM: no id associated to file "//&
-         &  TRIM(td_file%c_name))
+         &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name))
 
       ELSE      
@@ -661,5 +640,5 @@
          il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), &
          &                         il_dimid)
-         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
+         CALL iom_cdf__check(il_status)
 
          iom_cdf__read_dim_name=iom_cdf_read_dim(td_file, il_dimid)
@@ -673,5 +652,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -735,9 +714,9 @@
          &                                il_len, &
          &                                il_attid )
-         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+         CALL iom_cdf__check(il_status)
 
          !! get attribute value
-         CALL logger_debug( " IOM CDF READ ATT: get attribute "//&
-            &            TRIM(cl_name)//" in file "//TRIM(td_file%c_name))
+         CALL logger_debug( " IOM CDF READ ATT: get attribute "//TRIM(cl_name)//&
+         &               " in file "//TRIM(td_file%c_name))
 
          SELECT CASE( il_type )
@@ -749,6 +728,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put "//&
-                  &  "attribute "//TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
+                  &  TRIM(cl_name) )
 
                ELSE
@@ -758,5 +737,5 @@
                   &                      cl_name, &
                   &                      cl_value )
-                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+                  CALL iom_cdf__check(il_status)
 
                   iom_cdf__read_att_name=att_init(cl_name, cl_value)
@@ -779,5 +758,5 @@
                   &                      cl_name, &
                   &                      bl_value(:))
-                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+                  CALL iom_cdf__check(il_status)   
 
                   iom_cdf__read_att_name=att_init(cl_name, bl_value(:))
@@ -794,6 +773,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put "//&
-                  &  "attribute "//TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
+                  &  TRIM(cl_name) )
 
                ELSE
@@ -803,5 +782,5 @@
                   &                      cl_name, &
                   &                      sl_value(:))
-                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+                  CALL iom_cdf__check(il_status)   
 
                   iom_cdf__read_att_name=att_init(cl_name, sl_value(:))
@@ -818,6 +797,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put "//&
-                  &  "attribute "//TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
+                  &  TRIM(cl_name) )
 
                ELSE
@@ -827,5 +806,5 @@
                   &                      cl_name, &
                   &                      il_value(:))
-                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+                  CALL iom_cdf__check(il_status)   
 
                   iom_cdf__read_att_name=att_init(cl_name, il_value(:))
@@ -841,6 +820,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put "//&
-                  &  "attribute "//TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
+                  &  TRIM(cl_name) )
 
                ELSE
@@ -850,5 +829,5 @@
                   &                      cl_name, &
                   &                      fl_value(:))
-                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+                  CALL iom_cdf__check(il_status)   
 
                   iom_cdf__read_att_name=att_init(cl_name, fl_value(:))
@@ -865,6 +844,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put "//&
-                  &  "attribute "//TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
+                  &  TRIM(cl_name) )
 
                ELSE
@@ -874,5 +853,5 @@
                   &                      cl_name, &
                   &                      dl_value(:))
-                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+                  CALL iom_cdf__check(il_status)   
 
                   iom_cdf__read_att_name=att_init(cl_name, dl_value(:))
@@ -894,5 +873,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -923,5 +902,5 @@
          ! get attribute name
          il_status=NF90_INQ_ATTNAME(td_file%i_id, id_varid, id_attid, cl_name)
-         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+         CALL iom_cdf__check(il_status)
 
          ! read attribute
@@ -939,5 +918,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -997,5 +976,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1064,5 +1043,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1106,5 +1085,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1169,5 +1148,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1220,5 +1199,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - force to use FillValue=1.e20 if no FillValue for coordinate variable.
@@ -1261,5 +1240,5 @@
 
          ! inquire variable
-         CALL logger_debug( &
+         CALL logger_trace( &
          &  " IOM CDF READ VAR META: inquire variable "//&
          &  TRIM(fct_str(id_varid))//&
@@ -1274,8 +1253,7 @@
          &                                il_dimid(:),&
          &                                il_natt )
-         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ")
+         CALL iom_cdf__check(il_status)
          !!! fill variable dimension structure
          tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) )
-
          IF( il_natt /= 0 )THEN
             ALLOCATE( tl_att(il_natt) )
@@ -1298,10 +1276,10 @@
                ELSE
                   ! create attribute _FillValue
-                  SELECT CASE(TRIM(fct_lower(cl_name)))
+                  SELECT CASE(TRIM(cl_name))
                      CASE DEFAULT
                         CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
                         &                "zero for variable "//TRIM(cl_name) )
                         tl_fill=att_init('_FillValue',0.)
-                     CASE('nav_lon','nav_lat', 'nav_lev', &
+                     CASE('nav_lon','nav_lat', &
                         &  'glamt','glamu','glamv','glamf', &
                         &  'gphit','gphiu','gphiv','gphif')
@@ -1333,5 +1311,5 @@
             ALLOCATE(tl_att(il_natt+1) )
             ! create attribute _FillValue
-            SELECT CASE(TRIM(fct_lower(cl_name)))
+            SELECT CASE(TRIM(cl_name))
                CASE DEFAULT
                   CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
@@ -1375,8 +1353,6 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - Bug fix: use order to disorder table (see dim_init)
-   !>
+   !> - November, 2013- Initial Version
+   !
    !> @param[in] td_file   file structure
    !> @param[in] id_ndim   number of dimension
@@ -1395,5 +1371,5 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_2xyzt
 
       TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
@@ -1419,17 +1395,17 @@
 
          DO ji = 1, id_ndim
-            CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//&
-               &  "dimension "//TRIM(fct_str(ji)) )
-
-            il_xyzt2(ji)=td_file%t_dim(id_dimid(ji))%i_xyzt2
+            CALL logger_trace( " IOM CDF READ VAR DIM: get variable dimension "//&
+            &               TRIM(fct_str(ji)) )
+
+            il_2xyzt(ji)=td_file%t_dim(id_dimid(ji))%i_2xyzt
 
             ! read dimension information
-            tl_dim(ji) = dim_init( td_file%t_dim(il_xyzt2(ji))%c_name, &
-            &                      td_file%t_dim(il_xyzt2(ji))%i_len )
+            tl_dim(ji) = dim_init( td_file%t_dim(il_2xyzt(ji))%c_name, &
+            &                      td_file%t_dim(il_2xyzt(ji))%i_len )
          ENDDO
 
          ! reorder dimension to ('x','y','z','t')
          CALL dim_reorder(tl_dim(:))
- 
+      
          iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:))
 
@@ -1450,5 +1426,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1499,7 +1475,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - use scale factor and offset, as soon as read variable value
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1508,4 +1482,7 @@
    !> @param[in] id_count  number of indices selected along each dimension
    !> @return variable structure completed 
+   !
+   !> @todo
+   !> - warning do not change fill value when use scale factor..
    !-------------------------------------------------------------------
    SUBROUTINE iom_cdf__read_var_value(td_file, td_var, &
@@ -1519,13 +1496,12 @@
 
       ! local variable
-      INTEGER(i4)                                    :: il_status
-      INTEGER(i4)                                    :: il_tmp1
-      INTEGER(i4)                                    :: il_tmp2
-      INTEGER(i4)                                    :: il_varid
-      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
-      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
-      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start_ord
-      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count_ord
-
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4)                       :: il_tmp1
+      INTEGER(i4)                       :: il_tmp2
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start_ord
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count_ord
       REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
       REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_tmp
@@ -1542,6 +1518,6 @@
          IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
              ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
-            CALL logger_warn( "IOM CDF READ VAR VALUE: id_start and id_count"//&
-               & " should be both specify")
+            CALL logger_warn( &
+            &  "IOM CDF READ VAR VALUE: id_start and id_count should be both specify")
          ENDIF
          IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
@@ -1549,7 +1525,7 @@
             IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
             &   SIZE(id_count(:)) /= ip_maxdim )THEN
-               CALL logger_error("IOM CDF READ VAR: dimension of array start"//&
-                  &  " or count are invalid to read variable "//&
-                  &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name) )
+               CALL logger_error("IOM CDF READ VAR: dimension of array start or count "//&
+               &      " are invalid to read variable "//TRIM(td_var%c_name)//&
+               &      " in file "//TRIM(td_file%c_name) )
             ENDIF
 
@@ -1588,4 +1564,7 @@
             &    td_var%t_dim( 4 )%i_len &
             &                                            /)) )THEN
+
+            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//&
+            &  "variable dimension for "//TRIM(td_var%c_name) )
 
             DO ji = 1, ip_maxdim
@@ -1596,10 +1575,8 @@
                &  TRIM(fct_str(il_tmp2)))
             ENDDO
-            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//&
-            &  "variable dimension for "//TRIM(td_var%c_name) )
 
          ELSE
 
-            ! Allocate space to hold variable value (disorder)
+            ! Allocate space to hold variable value (unorder)
             ALLOCATE(dl_value( il_count(1), &
                &               il_count(2), &
@@ -1624,5 +1601,5 @@
             &                                       start = il_start(:),&
             &                                       count = il_count(:) )
-            CALL iom_cdf__check(il_status,"IOM CDF READ VAR VALUE: ")
+            CALL iom_cdf__check(il_status)
 
             ! Allocate space to hold variable value in structure
@@ -1686,11 +1663,4 @@
                CALL var_chg_FillValue(td_var)
             ENDIF
-
-            ! use scale factor and offset
-            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
-               td_var%d_value(:,:,:,:) = &
-               &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs
-            END WHERE
-
          ENDIF
       ELSE
@@ -1703,25 +1673,17 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine write file structure in an opened netcdf file.
-   !>
-   !> @details
-   !> optionally, you could specify dimension order (default 'xyzt')
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - add dimension order option 
+   !
+   !> @author J.Paul
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
    !-------------------------------------------------------------------
-   SUBROUTINE iom_cdf_write_file(td_file, cd_dimorder)
-      IMPLICIT NONE
-      ! Argument      
-      TYPE(TFILE)     , INTENT(INOUT) :: td_file
-      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+   SUBROUTINE iom_cdf_write_file(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
 
       ! local variable
       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
-
-      CHARACTER(LEN=lc)                      :: cl_dimorder
 
       TYPE(TVAR)                             :: tl_var
@@ -1732,9 +1694,5 @@
       INTEGER(i4) :: ji
       INTEGER(i4) :: jj
-      INTEGER(i4) :: jvar
-      !----------------------------------------------------------------
-
-      cl_dimorder='xyzt'
-      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(cd_dimorder)
+      !----------------------------------------------------------------
 
       ! check if file opened
@@ -1768,13 +1726,4 @@
             ENDIF
 
-            ! change dimension order
-            IF( TRIM(cl_dimorder) /= 'xyzt' )THEN
-               CALL dim_reorder(td_file%t_dim(:),TRIM(cl_dimorder))
-               DO jvar=1,td_file%i_nvar
-                  CALL logger_debug("VAR REORDER: "//TRIM(td_file%t_var(jvar)%c_name))
-                  CALL var_reorder(td_file%t_var(jvar),TRIM(cl_dimorder))
-               ENDDO
-            ENDIF
-
             ! write dimension in file
             DO ji = 1, ip_maxdim
@@ -1827,5 +1776,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1849,5 +1798,5 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
+         CALL iom_cdf__check(il_status)
 
          td_file%l_def=.TRUE.
@@ -1864,9 +1813,9 @@
             il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
             &                      NF90_UNLIMITED, td_dim%i_id)
-            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
+            CALL iom_cdf__check(il_status)
 
          ELSE
             ! write not unlimited dimension
-            CALL logger_debug( &
+            CALL logger_trace( &
             &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//&
             &  " in file "//TRIM(td_file%c_name))
@@ -1874,5 +1823,5 @@
             il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
             &                      td_dim%i_len, td_dim%i_id)
-            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
+            CALL iom_cdf__check(il_status)
 
          ENDIF
@@ -1885,5 +1834,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1910,5 +1859,5 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
+         CALL iom_cdf__check(il_status)
 
          td_file%l_def=.TRUE.
@@ -1927,5 +1876,5 @@
             il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
             &  td_att%c_name, td_att%c_value )
-            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
+            CALL iom_cdf__check(il_status)
 
          CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)
@@ -1933,5 +1882,5 @@
             il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
             &  td_att%c_name, td_att%d_value )
-            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
+            CALL iom_cdf__check(il_status)
 
       END SELECT
@@ -1942,5 +1891,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1968,10 +1917,10 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
+         CALL iom_cdf__check(il_status)
 
          td_file%l_def=.TRUE.
 
       ENDIF
- 
+      
       ! check if file and variable dimension conform
       IF( file_check_var_dim(td_file, td_var) )THEN
@@ -1989,15 +1938,10 @@
             ENDIF
          ENDDO
-         ! ugly patch until NEMO do not force to use 0. as FillValue 
          IF( ll_chg )THEN
             ! not a dimension variable
             ! change FillValue
-            SELECT CASE( TRIM(fct_lower(td_var%c_name)) )
-               CASE DEFAULT
-                  CALL var_chg_FillValue(td_var,0._dp)
-               CASE('nav_lon','nav_lat', &
-                  & 'glamt','glamu','glamv','glamf', &
-                  & 'gphit','gphiu','gphiv','gphif')
-            END SELECT
+
+            ! ugly patch until NEMO do not force to use 0. as FillValue 
+            CALL var_chg_FillValue(td_var,0._dp)
          ENDIF
 
@@ -2013,5 +1957,5 @@
             ! Leave define mode
             il_status=NF90_ENDDEF(td_file%i_id)
-            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
+            CALL iom_cdf__check(il_status)
 
             td_file%l_def=.FALSE.
@@ -2031,5 +1975,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2058,17 +2002,9 @@
       tl_var=var_copy(td_var)
 
-      ! forced to use float type
-      IF( tl_var%d_unf /= 1. .AND. tl_var%i_type==NF90_SHORT )THEN
-         tl_var%i_type=NF90_FLOAT
-      ENDIF
-
       IF( ALL( .NOT. tl_var%t_dim(:)%l_use ) )THEN
-         CALL logger_debug( &
-         &  "IOM CDF WRITE VAR DEF scalar: define variable "//&
-         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name))
          ! scalar value
          il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name), &
          &                        tl_var%i_type, varid=iom_cdf__write_var_def) 
-         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+         CALL iom_cdf__check(il_status)
       ELSE
 
@@ -2084,17 +2020,16 @@
          ENDDO
 
-         CALL logger_debug( &
+         CALL logger_trace( &
          &  "IOM CDF WRITE VAR DEF: define dimension to be used for variable "//&
          &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name))
 
          DO ji=1,jj
-            CALL logger_debug("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
+            CALL logger_trace("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
          ENDDO
-
          il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name),     &
          &                        tl_var%i_type,                         &
          &                        il_dimid(1:jj),                        &
          &                        varid=iom_cdf__write_var_def           )
-         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+         CALL iom_cdf__check(il_status)
       ENDIF
 
@@ -2108,13 +2043,8 @@
 
       DO ji = 1, tl_var%i_natt
-         CALL logger_debug( &
+         CALL logger_trace( &
          &  " IOM CDF WRITE VAR DEF: put attribute "//TRIM(tl_var%t_att(ji)%c_name)//&
          &  " for variable "//TRIM(tl_var%c_name)//&
          &  " in file "//TRIM(td_file%c_name) )
-
-         ! forced FillValue to have same type than variable
-         IF( TRIM(tl_var%t_att(ji)%c_name) == '_FillValue' )THEN
-            tl_var%t_att(ji)%i_type=tl_var%i_type
-         ENDIF
 
          IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN
@@ -2123,5 +2053,5 @@
                &                        TRIM(tl_var%t_att(ji)%c_name),        &
                &                        TRIM(tl_var%t_att(ji)%c_value)        )
-               CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+               CALL iom_cdf__check(il_status)
             ENDIF
          ELSE
@@ -2152,6 +2082,6 @@
                   &                        TRIM(tl_var%t_att(ji)%c_name),  &
                   &                        REAL(tl_var%t_att(ji)%d_value(:),dp))
-            END SELECT
-            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+               END SELECT
+            CALL iom_cdf__check(il_status)
          ENDIF
       ENDDO
@@ -2167,7 +2097,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - reuse scale factor and offset, before writing variable
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2194,11 +2122,5 @@
       &  "IOM CDF WRITE VAR VALUE: get dimension to be used for variable "//&
       &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
-   
-      ! use scale factor and offset
-      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
-         td_var%d_value(:,:,:,:) = &
-         &  (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf
-      END WHERE
-      
+
       jj=0
       DO ji = 1, ip_maxdim
@@ -2231,5 +2153,5 @@
 
       il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:))
-      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE: ")
+      CALL iom_cdf__check(il_status)
 
       DEALLOCATE( dl_value )
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 10251)
@@ -71,5 +71,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -106,5 +106,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -130,5 +130,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -194,5 +194,5 @@
    !
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -246,5 +246,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !>
    !> @todo
@@ -411,5 +411,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -465,5 +465,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -524,5 +524,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -636,5 +636,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -663,5 +663,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -691,5 +691,5 @@
    !>
    !> @author J.Paul
-   !> @date October, 2014 - Initial Version
+   !> - October, 2014- Initial Version
    !
    !> @param[in] td_mpp    mpp structure
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 10251)
@@ -87,5 +87,5 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date November, 2013 - Initial Version
+!> @date Nov, 2013 - Initial Version
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -137,5 +137,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -161,7 +161,4 @@
 
       ELSE
-         ! 
-         td_mpp%i_id=1
-
          ! if no processor file selected
          ! force to open all files 
@@ -224,5 +221,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -251,5 +248,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -270,7 +267,4 @@
 
       ELSE
-         ! 
-         td_mpp%i_id=0         
-
          DO ji=1,td_mpp%i_nproc
             IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
@@ -291,5 +285,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -320,11 +314,5 @@
          &               " in mpp strcuture "//TRIM(td_mpp%c_name))
 
-      ELSEIF( td_mpp%i_id == 0 )THEN
-
-         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
-         &               " can not read variable in "//TRIM(td_mpp%c_name))   
-      
       ELSE
-
 
          IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
@@ -367,5 +355,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -396,9 +384,4 @@
          &               " in mpp strcuture "//TRIM(td_mpp%c_name))
 
-      ELSEIF( td_mpp%i_id == 0 )THEN
-
-         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
-         &               " can not read variable in "//TRIM(td_mpp%c_name))   
-      
       ELSE
 
@@ -417,5 +400,5 @@
                CALL logger_error( &
                &  " IOM MPP READ VAR: there is no variable with "//&
-               &  "name or standard name "//TRIM(cd_name)//&
+               &  "name or standard name"//TRIM(cd_name)//&
                &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
             ENDIF
@@ -433,5 +416,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -484,15 +467,4 @@
       IF( PRESENT(id_count) ) il_count(:)=id_count(:)
 
-      CALL logger_debug("IOM MPP READ VAR VALUE: start "//&
-               &  TRIM(fct_str(il_start(jp_I)))//","//&
-               &  TRIM(fct_str(il_start(jp_J)))//","//&
-               &  TRIM(fct_str(il_start(jp_K)))//","//&
-               &  TRIM(fct_str(il_start(jp_L))) )
-      CALL logger_debug("IOM MPP READ VAR VALUE: count "//&
-               &  TRIM(fct_str(il_count(jp_I)))//","//&
-               &  TRIM(fct_str(il_count(jp_J)))//","//&
-               &  TRIM(fct_str(il_count(jp_K)))//","//&
-               &  TRIM(fct_str(il_count(jp_L))) )
-
       DO jk=1,ip_maxdim
          IF( .NOT. td_var%t_dim(jk)%l_use )THEN
@@ -504,15 +476,6 @@
       ENDDO
 
+
       IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN
-            CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//&
-               &  TRIM(fct_str(il_end(jp_I)))//","//&
-               &  TRIM(fct_str(il_end(jp_J)))//","//&
-               &  TRIM(fct_str(il_end(jp_K)))//","//&
-               &  TRIM(fct_str(il_end(jp_L))) )
-            CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//&
-               &  TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//&
-               &  TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//&
-               &  TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//&
-               &  TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) )
             CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//&
             &                 "exceed dimension bound.")
@@ -620,18 +583,14 @@
    !
    !> @details
-   !> optionally, you could specify the dimension order (default 'xyzt')
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 - add dimension order option 
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_mpp mpp structure
-   !> @param[In] cd_dimorder dimension order
-   !-------------------------------------------------------------------
-   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder)
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_mpp_write_file(td_mpp)
       IMPLICIT NONE
       ! Argument      
-      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
-      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
 
       ! local variable
@@ -651,5 +610,5 @@
                !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap')
 
-               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder)
+               CALL iom_write_file(td_mpp%t_proc(ji))
             ELSE
                CALL logger_debug( " MPP WRITE: no id associated to file "//&
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 10251)
@@ -131,5 +131,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -284,5 +284,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -328,5 +328,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -394,5 +394,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -544,5 +544,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -636,5 +636,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -688,5 +688,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -733,5 +733,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -778,5 +778,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -820,5 +820,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - Nov, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -863,5 +863,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - Nov, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -907,5 +907,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -972,5 +972,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1037,5 +1037,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1058,5 +1058,4 @@
       INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start
       INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count
-
       REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
 
@@ -1205,16 +1204,4 @@
       ENDIF
 
-      ! force to change _FillValue to avoid mistake 
-      ! with dummy zero _FillValue
-      IF( td_var%d_fill == 0._dp )THEN
-         CALL var_chg_FillValue(td_var)
-      ENDIF
-
-      ! use scale factor and offset
-      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
-         td_var%d_value(:,:,:,:) = &
-         &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs
-      END WHERE
-
    END SUBROUTINE iom_rstdimg__read_var_value
    !-------------------------------------------------------------------
@@ -1225,5 +1212,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date September, 2014
    !> - use iom_rstdimg__get_rec
@@ -1321,5 +1308,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1426,5 +1413,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1643,9 +1630,7 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015
-   !> - bug fix: do not use scale factor an offset for case no0d, no1d...
+   !> - November, 2013- Initial Version
    !>
-   !> @param[in] td_file file structure
+   !> @param[in] id_fileid file id
    !-------------------------------------------------------------------
    SUBROUTINE iom_rstdimg__write_var(td_file)
@@ -1682,14 +1667,4 @@
             CASE('no0d','no1d','no2d','no3d')
             CASE DEFAULT
-               
-               ! use scale factor and offset
-               WHERE( td_file%t_var(ji)%d_value(:,:,:,:) /= &
-               &      td_file%t_var(ji)%d_fill )
-                  td_file%t_var(ji)%d_value(:,:,:,:) = &
-                  &   ( td_file%t_var(ji)%d_value(:,:,:,:) - &
-                  &     td_file%t_var(ji)%d_ofs ) / &
-                  &   td_file%t_var(ji)%d_scf
-               END WHERE
-
                DO jk=1,td_file%t_var(ji)%t_dim(3)%i_len
                   SELECT CASE (td_file%t_var(ji)%i_ndim)
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/logger.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 10251)
@@ -16,7 +16,6 @@
 !> but not necessarily "wrong". 
 !>    - error : Other runtime errors or unexpected conditions.
-!>    - fatal : Severe errors that cause premature termination.
+!>    - fatal : Severe errors that cause premature termination.<br />
 !>  default verbosity is warning
-!>    - none  : to not create and write any information in logger file.<br />
 !
 !> If total number of error exceeded maximum number 
@@ -25,5 +24,5 @@
 !> to open/create logger file:<br/>
 !> @code
-!>    CALL logger_open(cd_file, [cd_verbosity,] [id_maxerror,] [id_loggerid])
+!>    CALL logger_open(cd_file, [cd_verbosity,] [id_loggerid,] [id_maxerror])
 !> @endcode
 !> - cd_file is logger file name
@@ -121,8 +120,5 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date November, 2013 - Initial Version
-!> @date February, 2015
-!> - check verbosity validity
-!> - add 'none' verbosity level to not used logger file
+!> @date November, 2013- Initial Version
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -155,9 +151,7 @@
 
    PRIVATE :: logger__write     ! cut message to get maximum of 80 character by line in log file
-   PRIVATE :: logger__check_verb! check verbosity validity
 
    TYPE TLOGGER   !< logger structure
       INTEGER(i4)       :: i_id = 0                 !< log file id
-      LOGICAL           :: l_use=.TRUE.             !< use logger or not
       CHARACTER(LEN=lc) :: c_name                   !< log file name
       CHARACTER(LEN=lc) :: c_verbosity = "warning"  !< verbosity choose
@@ -169,5 +163,5 @@
 
    !  module variable
-   INTEGER(i4), PARAMETER :: im_nverbosity=7     !< number of log level
+   INTEGER(i4), PARAMETER :: im_nverbosity=6     !< number of log level
    CHARACTER(len=*), DIMENSION(im_nverbosity), PARAMETER :: cm_verbosity= & !< verbosity array 
    &               (/ 'trace   ',&
@@ -176,6 +170,5 @@
    &                  'warning ',&
    &                  'error   ',&
-   &                  'fatal   ',&
-   &                  'none    '/)
+   &                  'fatal   '/)
 
    TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure
@@ -191,74 +184,62 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_file      log file name
    !> @param[in] cd_verbosity log file verbosity
+   !> @param[in] id_logid     log file id (use to flush)
    !> @param[in] id_maxerror  maximum number of error
-   !> @param[in] id_logid     log file id (use to flush)
-   !-------------------------------------------------------------------
-   SUBROUTINE logger_open(cd_file, cd_verbosity, id_maxerror, id_logid)
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_open(cd_file, cd_verbosity, id_logid, id_maxerror)
       IMPLICIT NONE
       ! Argument
       CHARACTER(len=*), INTENT(IN) :: cd_file                ! log file name
       CHARACTER(len=*), INTENT(IN), OPTIONAL :: cd_verbosity ! log file verbosity
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id
       INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error
-      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id
 
       ! local variable
       INTEGER(i4) :: il_status
 
-      LOGICAL     :: ll_valid
-
       ! loop
       INTEGER(i4) :: ji
       !----------------------------------------------------------------
+      ! get id if not already define
+      IF( PRESENT(id_logid) )THEN
+         tm_logger%i_id=id_logid
+      ELSE
+         tm_logger%i_id=fct_getunit()
+      ENDIF
+
+      ! open log file
+      OPEN( tm_logger%i_id, &
+      &     STATUS="unknown",    &
+      &     FILE=TRIM(ADJUSTL(cd_file)),  &
+      &     ACTION="write",      &
+      &     POSITION="append",   &
+      &     IOSTAT=il_status)
+      CALL fct_err(il_status)
+
+      ! keep filename
+      tm_logger%c_name=TRIM(ADJUSTL(cd_file))
 
       ! if present, change verbosity value
       IF( PRESENT(cd_verbosity) )THEN
-         ll_valid=logger__check_verb(TRIM(ADJUSTL(cd_verbosity)))
-         IF( ll_valid )THEN
-            tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity))
-         ENDIF
-      ENDIF
-
-      IF( TRIM(tm_logger%c_verbosity) == 'none' ) tm_logger%l_use=.FALSE.
-      
-      IF( tm_logger%l_use )THEN
-
-         ! get id if not already define
-         IF( PRESENT(id_logid) )THEN
-            tm_logger%i_id=id_logid
-         ELSE
-            tm_logger%i_id=fct_getunit()
-         ENDIF
-
-         ! open log file
-         OPEN( tm_logger%i_id, &
-         &     STATUS="unknown",    &
-         &     FILE=TRIM(ADJUSTL(cd_file)),  &
-         &     ACTION="write",      &
-         &     POSITION="append",   &
-         &     IOSTAT=il_status)
-         CALL fct_err(il_status)
-
-         ! keep filename
-         tm_logger%c_name=TRIM(ADJUSTL(cd_file))
-
-         ! compute "tab" of verbosity to be used
-         IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN
-            DO ji=im_nverbosity,1,-1
-               tm_logger%c_verb = &
-               &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji)))
-               IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN
-                  EXIT
-               ENDIF
-            ENDDO
-         ENDIF
-
-         IF( PRESENT(id_maxerror) )THEN
-            tm_logger%i_maxerror=id_maxerror
-         ENDIF
-
+         tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity))
+      ENDIF
+
+      ! compute "tab" of verbosity to be used
+      IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN
+         DO ji=im_nverbosity,1,-1
+            tm_logger%c_verb = &
+            &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji)))
+            IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+      IF( PRESENT(id_maxerror) )THEN
+         tm_logger%i_maxerror=id_maxerror
       ENDIF
 
@@ -268,5 +249,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_close()
@@ -275,15 +256,13 @@
       INTEGER(i4) :: il_status
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            tm_logger%i_id = 0
-            CLOSE( tm_logger%i_id, &
-            &      IOSTAT=il_status)      
-            CALL fct_err(il_status)
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_close')
-         ENDIF
+      IF( tm_logger%i_id /= 0 )THEN
+         tm_logger%i_id = 0
+         CLOSE( tm_logger%i_id, &
+         &      IOSTAT=il_status)      
+         CALL fct_err(il_status)
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_close')
       ENDIF
 
@@ -293,19 +272,17 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_flush()
       IMPLICIT NONE
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            CALL logger_close()
-            CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, &
-            &                 tm_logger%i_maxerror, tm_logger%i_id )     
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_flush')
-         ENDIF
+      IF( tm_logger%i_id /= 0 )THEN
+         CALL logger_close()
+         CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, tm_logger%i_id, &
+         &              tm_logger%i_maxerror )     
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_flush')
       ENDIF
 
@@ -315,5 +292,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !-------------------------------------------------------------------
    RECURSIVE SUBROUTINE logger_header()
@@ -322,19 +299,17 @@
       INTEGER(i4)       :: il_status
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            WRITE( tm_logger%i_id,    &
-               &   FMT='(4(a/))',     &
-               &   IOSTAT=il_status ) &
-               &   "--------------------------------------------------",&
-               &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),&
-               &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), &
-               &   "--------------------------------------------------"
-            CALL fct_err(il_status)
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_header')
-         ENDIF
+      IF( tm_logger%i_id /= 0 )THEN
+         WRITE( tm_logger%i_id,    &
+            &   FMT='(4(a/))',     &
+            &   IOSTAT=il_status ) &
+            &   "--------------------------------------------------",&
+            &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),&
+            &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), &
+            &   "--------------------------------------------------"
+         CALL fct_err(il_status)
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_header')
       ENDIF
 
@@ -344,5 +319,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_footer()
@@ -351,22 +326,20 @@
       INTEGER(i4)       :: il_status
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            WRITE( tm_logger%i_id,    &
-               &   FMT='(4(/a))',     &
-               &   IOSTAT=il_status ) &
-               &   "--------------------------------------------------",&
-               &   "END      : log ended ",              &
-               &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   &
-               &   " ERROR detected ",                                  &
-               &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   &
-               &   " FATAL detected ",                                  &
-               &   "--------------------------------------------------"
-            CALL fct_err(il_status)
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_footer')
-         ENDIF
+      IF( tm_logger%i_id /= 0 )THEN
+         WRITE( tm_logger%i_id,    &
+            &   FMT='(4(/a))',     &
+            &   IOSTAT=il_status ) &
+            &   "--------------------------------------------------",&
+            &   "END      : log ended ",              &
+            &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   &
+            &   " ERROR detected ",                                  &
+            &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   &
+            &   " FATAL detected ",                                  &
+            &   "--------------------------------------------------"
+         CALL fct_err(il_status)
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_footer')
       ENDIF
    END SUBROUTINE logger_footer
@@ -377,5 +350,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -388,21 +361,19 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN
-
-               CALL logger__write("TRACE   :",cd_msg)
-
-               IF( PRESENT(ld_flush) )THEN
-                  IF( ld_flush )THEN
-                     CALL logger_flush()
-                  ENDIF
-               ENDIF      
-            ENDIF
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_trace')
+      IF( tm_logger%i_id /= 0 )THEN
+         IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN
+
+            CALL logger__write("TRACE   :",cd_msg)
+
+            IF( PRESENT(ld_flush) )THEN
+               IF( ld_flush )THEN
+                  CALL logger_flush()
+               ENDIF
+            ENDIF      
          ENDIF
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_trace')
       ENDIF
    END SUBROUTINE logger_trace
@@ -413,5 +384,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -424,21 +395,19 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN
-
-               CALL logger__write("DEBUG   :",cd_msg)
-
-               IF( PRESENT(ld_flush) )THEN
-                  IF( ld_flush )THEN
-                     CALL logger_flush()
-                  ENDIF
-               ENDIF      
-            ENDIF
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_debug')
+      IF( tm_logger%i_id /= 0 )THEN
+         IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN
+
+            CALL logger__write("DEBUG   :",cd_msg)
+
+            IF( PRESENT(ld_flush) )THEN
+               IF( ld_flush )THEN
+                  CALL logger_flush()
+               ENDIF
+            ENDIF      
          ENDIF
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_debug')
       ENDIF
    END SUBROUTINE logger_debug
@@ -449,5 +418,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -460,21 +429,19 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN
-
-               CALL logger__write("INFO    :",cd_msg)
-
-               IF( PRESENT(ld_flush) )THEN
-                  IF( ld_flush )THEN
-                     CALL logger_flush()
-                  ENDIF
-               ENDIF      
-            ENDIF
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_info')
+      IF( tm_logger%i_id /= 0 )THEN
+         IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN
+
+            CALL logger__write("INFO    :",cd_msg)
+
+            IF( PRESENT(ld_flush) )THEN
+               IF( ld_flush )THEN
+                  CALL logger_flush()
+               ENDIF
+            ENDIF      
          ENDIF
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_info')
       ENDIF
    END SUBROUTINE logger_info
@@ -485,5 +452,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -496,21 +463,19 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN
-
-               CALL logger__write("WARNING :",cd_msg)
-
-               IF( PRESENT(ld_flush) )THEN
-                  IF( ld_flush )THEN
-                     CALL logger_flush()
-                  ENDIF
-               ENDIF      
-            ENDIF
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_warn')
+      IF( tm_logger%i_id /= 0 )THEN
+         IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN
+
+            CALL logger__write("WARNING :",cd_msg)
+
+            IF( PRESENT(ld_flush) )THEN
+               IF( ld_flush )THEN
+                  CALL logger_flush()
+               ENDIF
+            ENDIF      
          ENDIF
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_warn')
       ENDIF
    END SUBROUTINE logger_warn
@@ -521,5 +486,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -535,33 +500,30 @@
       CHARACTER(LEN=lc) :: cl_nerror
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            IF( TRIM(tm_logger%c_verb) /= 'none' )THEN
-               ! increment the error number
-               tm_logger%i_nerror=tm_logger%i_nerror+1
-            ENDIF
-
-            IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN
-
-               CALL logger__write("ERROR   :",cd_msg)
-
-               IF( PRESENT(ld_flush) )THEN
-                  IF( ld_flush )THEN
-                     CALL logger_flush()
-                  ENDIF
-               ENDIF      
-            ENDIF
-
-            IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN
-               WRITE(cl_nerror,*) tm_logger%i_maxerror
-               CALL logger_fatal(&
-               &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) )
-            ENDIF
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_error')
+      IF( tm_logger%i_id /= 0 )THEN
+         ! increment the error number
+         tm_logger%i_nerror=tm_logger%i_nerror+1
+
+         IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN
+
+            CALL logger__write("ERROR   :",cd_msg)
+
+            IF( PRESENT(ld_flush) )THEN
+               IF( ld_flush )THEN
+                  CALL logger_flush()
+               ENDIF
+            ENDIF      
          ENDIF
-      ENDIF
+
+         IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN
+            WRITE(cl_nerror,*) tm_logger%i_maxerror
+            CALL logger_fatal(&
+            &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) )
+         ENDIF
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_error')
+      ENDIF
+
    END SUBROUTINE logger_error
    !-------------------------------------------------------------------
@@ -570,5 +532,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_msg message to write
@@ -579,23 +541,21 @@
       CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
       !----------------------------------------------------------------
-      IF( tm_logger%l_use )THEN
-         IF( tm_logger%i_id /= 0 )THEN
-            IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN
-               ! increment the error number
-               tm_logger%i_nfatal=tm_logger%i_nfatal+1
-
-               CALL logger__write("FATAL   :",cd_msg)
-
-               CALL logger_footer()
-               CALL logger_close()
-
-               WRITE(*,*) 'FATAL ERROR'
-               STOP
-            ENDIF
-         ELSE
-             CALL logger_open('logger.log')
-             CALL logger_header()
-             CALL logger_fatal('you must have create logger to use logger_fatal')
+      IF( tm_logger%i_id /= 0 )THEN
+         IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN
+            ! increment the error number
+            tm_logger%i_nfatal=tm_logger%i_nfatal+1
+
+            CALL logger__write("FATAL   :",cd_msg)
+
+            CALL logger_footer()
+            CALL logger_close()
+
+            WRITE(*,*) 'FATAL ERROR'
+            STOP
          ENDIF
+      ELSE
+          CALL logger_open('logger.log')
+          CALL logger_header()
+          CALL logger_fatal('you must have create logger to use logger_fatal')
       ENDIF
    END SUBROUTINE logger_fatal
@@ -605,5 +565,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_verb   verbosity of the message to write
@@ -655,43 +615,4 @@
 
    END SUBROUTINE logger__write
-   !-------------------------------------------------------------------
-   !> @brief This function check validity of verbosity.
-   !>
-   !> @author J.Paul
-   !> @date February, 2015 - Initial Version
-   !
-   !> @param[in] cd_verb   verbosity of the message to write
-   !> @return verbosity is valid or not
-   !-------------------------------------------------------------------
-   FUNCTION logger__check_verb(cd_verb)
-      IMPLICIT NONE
-      ! Argument
-      CHARACTER(LEN=*),           INTENT(IN) :: cd_verb
-
-      !function
-      LOGICAL           :: logger__check_verb
-
-      ! local variable
-      ! loop indices
-      INTEGER(i4) :: ji
-
-      !----------------------------------------------------------------
-      logger__check_verb=.FALSE.
-
-      DO ji=1,im_nverbosity
-         IF( TRIM(cd_verb) == TRIM(cm_verbosity(ji)) )THEN
-            logger__check_verb=.TRUE.
-            EXIT
-         ENDIF
-      ENDDO
-
-      IF( .NOT. logger__check_verb )THEN
-         CALL logger_open('logger.log')
-         CALL logger_header()
-         CALL logger_fatal('LOGGER : invalid verbosity, check namelist.'//&
-         &                 ' default one will be used.')
-         CALL logger_footer()
-      ENDIF
-   END FUNCTION logger__check_verb
 END MODULE logger
 
Index: anches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/math.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 10250)
+++ 	(revision )
@@ -1,1285 +1,0 @@
-!----------------------------------------------------------------------
-! NEMO system team, System and Interface for oceanic RElocable Nesting
-!----------------------------------------------------------------------
-!
-! MODULE: math
-!
-! DESCRIPTION:
-!> @brief
-!> This module groups some useful mathematical function.
-!>
-!> @details
-!> 
-!>    to compute the mean of an array:<br/>
-!> @code
-!>    dl_value=math_mean( dl_value, dd_fill )
-!> @endcode
-!>       - dl_value is 1D or 2D array
-!>       - dd_fill is FillValue
-!>
-!>    to compute the median of an array:<br/>
-!> @code
-!>    dl_value=math_median( dl_value, dd_fill )
-!> @endcode
-!>       - dl_value is 1D or 2D array
-!>       - dd_fill is FillValue
-!>
-!>    to compute the mean without extremum of an array:<br/>
-!> @code
-!>    dl_value=math_mwe( dl_value, id_next, dd_fill )
-!> @endcode
-!>       - dl_value is 1D or 2D array
-!>       - id_next is the number of extremum to be removed
-!>       - dd_fill is FillValue
-!>
-!>    to sort an 1D array:<br/>
-!> @code
-!>    CALL math_QsortC(dl_value)
-!> @endcode
-!>       - dl_value is 1D array
-!>
-!>    to correct phase angles to produce smoother phase:<br/>
-!> @code
-!>    CALL math_unwrap(dl_value, [dl_discont])
-!> @endcode
-!>       - dl_value is 1D array
-!>       - dl_discont maximum discontinuity between values, default pi
-!>
-!>    to compute simple operation
-!> @code
-!>    dl_res=math_compute(cl_var)
-!> @endcode
-!>       - cl_var operation to compute (string of character)
-!>       - dl_res result of the operation, real(dp)
-!>
-!>    to compute first derivative of 1D array:<br/>
-!> @code
-!>    dl_value(:)=math_deriv_1D( dd_value(:), dd_fill, [ld_discont] )
-!> @endcode
-!>       - dd_value is 1D array of variable
-!>       - dd_fill is FillValue of variable
-!>       - ld_discont is logical to take into account longitudinal 
-!>         East-West discontinuity [optional]
-!>
-!>    to compute first derivative of 2D array:<br/>
-!> @code
-!>    dl_value(:,:)=math_deriv_2D( dd_value(:,:), dd_fill, cd_dim, 
-!>                  [ld_discont] )
-!> @endcode
-!>       - dd_value is 2D array of variable
-!>       - dd_fill is FillValue of variable
-!>       - cd_dim is character to compute derivative on first (I) or
-!>         second (J) dimension
-!>       - ld_discont is logical to take into account longitudinal 
-!>         East-West discontinuity [optional]
-!>
-!>    to compute first derivative of 3D array:<br/>
-!> @code
-!>    dl_value(:,:,:)=math_deriv_3D( dd_value(:,:,:), dd_fill, cd_dim,
-!>                    [ld_discont] )
-!> @endcode
-!>       - dd_value is 3D array of variable
-!>       - dd_fill is FillValue of variable
-!>       - cd_dim is character to compute derivative on first (I), second (J),
-!>         or third (K) dimension
-!>       - ld_discont is logical to take into account longitudinal East-West 
-!>         discontinuity [optional]
-!>
-!>
-!> @author
-!> J.Paul
-! REVISION HISTORY:
-!> @date January, 2015 - Initial version
-!
-!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-!----------------------------------------------------------------------
-MODULE math
-   USE kind                            ! F90 kind parameter
-   USE global                          ! global variable
-   USE phycst                          ! physical constant
-   USE fct                             ! basic useful function
-   IMPLICIT NONE
-   ! NOTE_avoid_public_variables_if_possible
-
-   ! function and subroutine
-   PUBLIC :: math_mean      !< return mean of an array
-   PUBLIC :: math_median    !< return median of an array
-   PUBLIC :: math_mwe       !< return mean without extremum of an array
-   PUBLIC :: math_QsortC    !< sort an 1D array
-   PUBLIC :: math_unwrap    !< correct phase angles to produce smoother phase
-   PUBLIC :: math_compute   !< compute simple operation
-   PUBLIC :: math_deriv_1D  !< compute first derivative of 1D array 
-   PUBLIC :: math_deriv_2D  !< compute first derivative of 2D array 
-   PUBLIC :: math_deriv_3D  !< compute first derivative of 3D array
-
-
-   PRIVATE :: math__Partition
-   PRIVATE :: math__mean_1d
-   PRIVATE :: math__mean_2d
-   PRIVATE :: math__median_1d
-   PRIVATE :: math__median_2d
-   PRIVATE :: math__mwe_1d
-   PRIVATE :: math__mwe_2d
-   PRIVATE :: math__parentheses
-
-
-   INTERFACE math_mean
-      MODULE PROCEDURE math__mean_1d ! return mean of an array 1D
-      MODULE PROCEDURE math__mean_2d ! return mean of an array 2D
-   END INTERFACE math_mean
-
-   INTERFACE math_median
-      MODULE PROCEDURE math__median_1d ! return median of an array 1D
-      MODULE PROCEDURE math__median_2d ! return median of an array 2D
-   END INTERFACE math_median
-
-   INTERFACE math_mwe
-      MODULE PROCEDURE math__mwe_1d ! return mean without extremum of an array 1D
-      MODULE PROCEDURE math__mwe_2d ! return mean without extremum of an array 2D
-   END INTERFACE math_mwe
-
-CONTAINS
-   !------------------------------------------------------------------- 
-   !> @brief This function compute the mean of a 1D array. 
-   ! 
-   !> @author J.Paul 
-   !> @date January, 2015 - Initial Version 
-   ! 
-   !> @param[in] dd_array  1D array 
-   !> @param[in] dd_fill   fillValue
-   !> @return mean value, real(dp)
-   !------------------------------------------------------------------- 
-   PURE REAL(dp) FUNCTION math__mean_1d(dd_array, dd_fill)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
-      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
-
-      ! local variable
-      INTEGER(i4)  :: il_count
-      REAL(dp)     :: dl_sum
-      REAL(dp)     :: dl_count
-      !----------------------------------------------------------------
-      
-      IF( PRESENT(dd_fill) )THEN
-         il_count=COUNT(dd_array(:)/=dd_fill)
-         IF( il_count > 0 )THEN
-            dl_sum  =SUM ( dd_array(:), dd_array(:)/= dd_fill )
-            dl_count=REAL( il_count, dp)
-
-            math__mean_1d=dl_sum/dl_count
-         ELSE
-            math__mean_1d=dd_fill
-         ENDIF
-      ELSE
-         il_count=SIZE(dd_array(:))
-         IF( il_count > 0 )THEN
-            dl_sum  =SUM ( dd_array(:) )
-            dl_count=REAL( il_count, dp)
-
-            math__mean_1d=dl_sum/dl_count
-         ELSE
-            math__mean_1d=0
-         ENDIF
-      ENDIF
-
-   END FUNCTION math__mean_1d
-   !------------------------------------------------------------------- 
-   !> @brief This function compute the mean of a 2D array. 
-   ! 
-   !> @author J.Paul 
-   !> @date January, 2015 - Initial Version 
-   ! 
-   !> @param[in] dd_array  2D array 
-   !> @param[in] dd_fill   fillValue
-   !> @return mean value, real(dp)
-   !------------------------------------------------------------------- 
-   PURE REAL(dp) FUNCTION math__mean_2d(dd_array, dd_fill)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
-      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
-
-      ! local variable
-      INTEGER(i4)                         :: il_count
-
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
-      !----------------------------------------------------------------
-
-      IF( PRESENT(dd_fill)  )THEN
-         il_count=COUNT(dd_array(:,:)/=dd_fill)
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
-         ELSE
-            math__mean_2d=dd_fill
-         ENDIF
-      ELSE
-         il_count=SIZE(dd_array)
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
-         ELSE
-            math__mean_2d=0
-         ENDIF
-      ENDIF
-
-      IF( ALLOCATED(dl_list) )THEN
-         math__mean_2d=math_mean(dl_list(:))
-         DEALLOCATE( dl_list )
-      ENDIF
-
-   END FUNCTION math__mean_2d
-   !------------------------------------------------------------------- 
-   !> @brief This function compute the median of a 1D array. 
-   ! 
-   !> @author J.Paul 
-   !> @date January, 2015 - Initial Version 
-   ! 
-   !> @param[in] dd_array  1D array 
-   !> @param[in] dd_fill   fillValue
-   !> @return median value, real(dp)
-   !-------------------------------------------------------------------
-   PURE REAL(dp) FUNCTION math__median_1d(dd_array, dd_fill)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
-      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
-
-      ! local variable
-      INTEGER(i4)                         :: il_count
-
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
-      !----------------------------------------------------------------
-      
-      IF( PRESENT(dd_fill)  )THEN
-         il_count=COUNT(dd_array(:)/=dd_fill)
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=PACK(dd_array(:),dd_array(:)/=dd_fill)
-         ELSE
-            math__median_1d=dd_fill
-         ENDIF
-      ELSE
-         il_count=SIZE(dd_array(:))
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=dd_array(:)
-         ELSE
-            math__median_1d=0
-         ENDIF
-      ENDIF
-
-      IF( ALLOCATED(dl_list) )THEN
-         CALL math_QsortC(dl_list(:))
-
-         IF( MOD(il_count,2) == 0 )THEN
-            math__median_1d=(dl_list(il_count/2+1)+dl_list(il_count/2))/2_dp
-         ELSE
-            math__median_1d=dl_list(il_count/2+1)
-         ENDIF
-
-         DEALLOCATE(dl_list)
-      ENDIF
-
-   END FUNCTION math__median_1d
-   !------------------------------------------------------------------- 
-   !> @brief This function compute the median of a 2D array. 
-   ! 
-   !> @author J.Paul 
-   !> @date January, 2015 - Initial Version 
-   ! 
-   !> @param[in] dd_array  2D array 
-   !> @param[in] dd_fill   fillValue
-   !> @return median value, real(dp)
-   !-------------------------------------------------------------------
-   PURE REAL(dp) FUNCTION math__median_2d(dd_array, dd_fill)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
-      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
-
-      ! local variable
-      INTEGER(i4)                         :: il_count
-
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
-      !----------------------------------------------------------------
-      
-      IF( PRESENT(dd_fill)  )THEN
-         il_count=COUNT(dd_array(:,:)/=dd_fill)
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
-         ELSE
-            math__median_2d=dd_fill
-         ENDIF
-      ELSE
-         il_count=SIZE(dd_array(:,:))
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
-         ELSE
-            math__median_2d=0
-         ENDIF
-      ENDIF
-
-      IF( ALLOCATED(dl_list) )THEN
-         math__median_2d=math_median(dl_list(:))
-         DEALLOCATE(dl_list)
-      ENDIF
-
-   END FUNCTION math__median_2d
-   !------------------------------------------------------------------- 
-   !> @brief This function compute the mean without extremum of a 1D array. 
-   ! 
-   !> @author J.Paul 
-   !> @date January, 2015 - Initial Version 
-   ! 
-   !> @param[in] dd_array  1D array 
-   !> @param[in] id_next   number of extremum to be removed
-   !> @param[in] dd_fill   fillValue
-   !> @return median value, real(dp)
-   !-------------------------------------------------------------------
-   PURE REAL(dp) FUNCTION math__mwe_1d(dd_array, id_next, dd_fill)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
-      INTEGER(i4)           , INTENT(IN), OPTIONAL :: id_next
-      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
-
-      ! local variable
-      INTEGER(i4)                         :: il_next
-      INTEGER(i4)                         :: il_count
-      INTEGER(i4)                         :: il_size
-
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
-      !----------------------------------------------------------------
-
-      il_next=2
-      IF( PRESENT(id_next) ) il_next=id_next
-      
-      il_size=SIZE(dd_array(:))
-      IF( PRESENT(dd_fill)  )THEN
-         il_count=COUNT(dd_array(:)/=dd_fill)
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=PACK(dd_array(:),dd_array(:)/=dd_fill)
-         ELSE
-            math__mwe_1d=dd_fill
-         ENDIF
-      ELSE
-         il_count=SIZE(dd_array(:))
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=dd_array(:)
-         ELSE
-            math__mwe_1d=0
-         ENDIF
-      ENDIF
-
-      IF( ALLOCATED(dl_list) )THEN
-         CALL math_QsortC(dl_list(:))
-
-         IF( il_count == il_size )THEN
-            ! no fillValue
-            math__mwe_1d=math_mean(dl_list(il_next+1:il_size-il_next))
-         ELSEIF( il_count > il_size-2*il_next )THEN
-            ! remove one extremum each side
-            math__mwe_1d=math_mean(dl_list(2:il_size-1))
-         ELSE ! il_count <= il_size-2*il_next
-            ! more than 2*il_next fillValue
-            ! compute mean only
-            math__mwe_1d=math_mean(dl_list(:))
-         ENDIF
-
-         DEALLOCATE(dl_list)
-      ENDIF
-
-   END FUNCTION math__mwe_1d
-   !------------------------------------------------------------------- 
-   !> @brief This function compute the mean without extremum of a 2D array. 
-   ! 
-   !> @author J.Paul 
-   !> @date January, 2015 - Initial Version 
-   ! 
-   !> @param[in] dd_array  2D array 
-   !> @param[in] id_next   number of extremum to be removed
-   !> @param[in] dd_fill   fillValue
-   !> @return median value, real(dp)
-   !-------------------------------------------------------------------
-   PURE REAL(dp) FUNCTION math__mwe_2d(dd_array, id_next, dd_fill)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
-      INTEGER(i4)             , INTENT(IN), OPTIONAL :: id_next
-      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
-
-      ! local variable
-      INTEGER(i4)                         :: il_count
-
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
-      !----------------------------------------------------------------
-      
-      IF( PRESENT(dd_fill)  )THEN
-         il_count=COUNT(dd_array(:,:)/=dd_fill)
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
-
-            math__mwe_2d=math_mwe(dl_list(:), id_next)
-         ELSE
-            math__mwe_2d=dd_fill
-         ENDIF
-      ELSE
-         il_count=SIZE(dd_array(:,:))
-         IF( il_count > 0 )THEN
-            ALLOCATE( dl_list(il_count) )
-            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
-
-            math__mwe_2d=math_mwe(dl_list(:), id_next)
-         ELSE
-            math__mwe_2d=0
-         ENDIF
-      ENDIF
-
-      IF( ALLOCATED(dl_list) ) DEALLOCATE(dl_list)
-
-   END FUNCTION math__mwe_2d
-   !------------------------------------------------------------------- 
-   !> @brief This subroutine sort a 1D array. 
-   !>
-   !> @details
-   !> Recursive Fortran 95 quicksort routine
-   !> sorts real numbers into ascending numerical order
-   !> Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
-   !> Based on algorithm from Cormen et al., Introduction to Algorithms,
-   !> 1997 printing
-   !> 
-   !> @author J.Paul 
-   !> @date January, 2015 - Rewrite with SIREN coding rules 
-   ! 
-   !> @param[inout] dd_array  1D array 
-   !-------------------------------------------------------------------
-   PURE RECURSIVE SUBROUTINE math_QsortC(dd_array)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_array
-
-      ! local variable
-      INTEGER(i4) :: il_iq
-      !----------------------------------------------------------------
-     
-      IF( SIZE(dd_array(:)) > 1 )THEN
-         CALL math__Partition(dd_array, il_iq)
-         CALL math_QsortC(dd_array(:il_iq-1))
-         CALL math_QsortC(dd_array(il_iq:))
-      ENDIF
-
-   END SUBROUTINE math_QsortC
-   !------------------------------------------------------------------- 
-   !> @brief This subroutine partition a 1D array. 
-   !>
-   !> @details
-   !> Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
-   !> Based on algorithm from Cormen et al., Introduction to Algorithms,
-   !> 1997 printing
-   !> 
-   !> @author J.Paul 
-   !> @date January, 2015 - Rewrite with SIREN coding rules 
-   ! 
-   !> @param[inout] dd_array  1D array 
-   !> @param[in] id_marker 
-   !-------------------------------------------------------------------
-   PURE SUBROUTINE math__Partition(dd_array, id_marker)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_array
-      INTEGER(i4),               INTENT(  OUT) :: id_marker
-
-      ! local variable
-      REAL(dp)    :: dl_temp
-      REAL(dp)    :: dl_x     ! pivot point
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
-      !----------------------------------------------------------------
-
-      dl_x = dd_array(1)
-      ji= 0
-      jj= SIZE(dd_array(:)) + 1
-
-      DO 
-         jj=jj-1
-         DO
-            IF( dd_array(jj) <= dl_x ) EXIT
-            jj=jj-1
-         ENDDO
-         ji=ji+1
-         DO
-            IF( dd_array(jj) >= dl_x ) EXIT
-            ji=ji+1
-         ENDDO
-         IF( ji < jj )THEN
-            ! exchange dd_array(ji) and dd_array(jj)
-            dl_temp= dd_array(ji)
-            dd_array(ji) = dd_array(jj)
-            dd_array(jj) = dl_temp
-         ELSEIF( ji==jj )THEN
-            id_marker=ji+1
-            RETURN
-         ELSE
-            id_marker=ji
-            RETURN
-         ENDIF
-      ENDDO
-
-   END SUBROUTINE math__Partition
-   !------------------------------------------------------------------- 
-   !> @brief This subroutine correct phase angles to produce smoother 
-   !> phase plots. 
-   !>
-   !> @details
-   !> This code is based on numpy unwrap function
-   !>
-   !> Unwrap by changing deltas between values to 2*pi complement.
-   !>
-   !> Unwrap radian phase `dd_array` by changing absolute jumps greater than
-   !> `dd_discont` to their 2*pi complement.
-   !>
-   !> @note If the discontinuity in `dd_array` is smaller than ``pi``, 
-   !> but larger than `dd_discont`, no unwrapping is done because taking
-   !> the 2*pi complement would only make the discontinuity larger.
-   !>
-   !> @author J.Paul 
-   !> @date Marsh, 2015 - Rewrite in fortran, with SIREN coding rules 
-   ! 
-   !> @param[inout] dd_array  1D array 
-   !> @param[in] dd_discont maximum discontinuity between values, default pi
-   !-------------------------------------------------------------------
-   PURE SUBROUTINE math_unwrap(dd_array, dd_discont)
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_array
-      REAL(dp)   ,               INTENT(IN   ), OPTIONAL :: dd_discont
-
-      ! local variable
-      INTEGER(i4)                         :: il_size
-
-      REAL(dp)                            :: dl_discont
-
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_diff
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_mod
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_correct
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_tmp
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      !----------------------------------------------------------------
-      dl_discont=dp_pi
-      IF( PRESENT(dd_discont) ) dl_discont=dd_discont
-
-      il_size=SIZE(dd_array)
-      ALLOCATE(dl_diff(il_size-1))
-      DO ji=1,il_size-1
-         dl_diff(ji)=dd_array(ji+1)-dd_array(ji)
-      ENDDO
-
-      ALLOCATE(dl_mod(il_size-1))
-      DO ji=1,il_size-1
-         dl_mod(ji) = MOD(dl_diff(ji) + dp_pi, 2*dp_pi) - dp_pi
-      ENDDO
-
-      WHERE( (dl_mod(:) == -dp_pi) .AND. (dl_diff(:) > 0._dp ) )
-         dl_mod(:)=dp_pi
-      END WHERE
-
-      ALLOCATE(dl_correct(il_size-1))
-      dl_correct(:)=dl_mod(:)-dl_diff(:)
-
-      DEALLOCATE(dl_mod)
-
-      WHERE( ABS(dl_diff(:)) < dl_discont )
-         dl_correct(:)=0._dp
-      END WHERE
-
-      DEALLOCATE(dl_diff)
-      
-      ALLOCATE(dl_tmp(il_size))
-      dl_tmp(:)=dd_array(:)
-
-      DO ji=1,il_size-1
-         dd_array(ji+1)=dl_tmp(ji+1)+SUM(dl_correct(1:ji))
-      ENDDO
-
-      DEALLOCATE(dl_correct)
-      DEALLOCATE(dl_tmp)
-
-   END SUBROUTINE math_unwrap
-   !------------------------------------------------------------------- 
-   !> @brief This function compute simple operation 
-   !>
-   !> @details
-   !> - operation should be write as a string of character.
-   !> - operators allowed are : +,-,*,/ 
-   !> - to ordered operation you should use parentheses
-   !>
-   !> exemples: '1e6/(16/122)', '(3/2)*(2+1)' 
-   !>
-   !> @author J.Paul 
-   !> @date June, 2015 - initial version
-   ! 
-   !> @param[in] cd_var operation to compute (string of character)  
-   !> @return result of the operation, real(dp)
-   !-------------------------------------------------------------------
-   REAL(dp) RECURSIVE FUNCTION math_compute(cd_var) RESULT(dd_res)
-      IMPLICIT NONE
-      ! Argument      
-      CHARACTER(LEN=*), INTENT(IN) :: cd_var
-   
-      ! local variables
-      CHARACTER(LEN=lc) :: cl_var
-      CHARACTER(LEN=lc) :: cl_str1
-      CHARACTER(LEN=lc) :: cl_str2
-   
-      INTEGER(i4)       :: il_ind
-      ! loop indices
-      !----------------------------------------------------------------
-   
-   
-      IF(fct_is_real(cd_var))THEN
-         READ(cd_var,*) dd_res
-      ELSE
-      
-   
-         CALL math__parentheses(cd_var, cl_var)
-         
-         IF(fct_is_real(cl_var))THEN
-            READ(cl_var,*) dd_res
-         ELSE
-            il_ind=SCAN(TRIM(cl_var),'*')
-            IF( il_ind /= 0 )THEN
-               cl_str1=cl_var(1:il_ind-1)
-               cl_str2=cl_var(il_ind+1:)
-               dd_res=math_compute(cl_str1)*math_compute(cl_str2)
-            ELSE
-               il_ind=SCAN(TRIM(cl_var),'/')
-               IF( il_ind /= 0 )THEN
-                  cl_str1=cl_var(1:il_ind-1)
-                  cl_str2=cl_var(il_ind+1:)
-                  dd_res=math_compute(cl_str1)/math_compute(cl_str2)
-               ELSE
-                  il_ind=SCAN(TRIM(cl_var),'+')
-                  IF( il_ind /= 0 )THEN
-                     cl_str1=cl_var(1:il_ind-1)
-                     cl_str2=cl_var(il_ind+1:)
-                     dd_res=math_compute(cl_str1)+math_compute(cl_str2)
-                  ELSE
-                     il_ind=SCAN(TRIM(cl_var),'-')
-                     IF( il_ind /= 0 )THEN
-                        cl_str1=cl_var(1:il_ind-1)
-                        cl_str2=cl_var(il_ind+1:)
-                        dd_res=math_compute(cl_str1)-math_compute(cl_str2)
-                     ELSE
-                        dd_res=dp_fill
-                     ENDIF
-                  ENDIF
-               ENDIF
-            ENDIF
-         ENDIF
-      ENDIF
-   
-   END FUNCTION math_compute
-   !------------------------------------------------------------------- 
-   !> @brief This subroutine replace sub string inside parentheses
-   !> by the value of the operation inside.
-   !>
-   !> @details
-   !> exemple : 
-   !> - '2.6+(3/2)' => '2.6+1.5000'
-   !>
-   !> @author J.Paul 
-   !> @date June, 2015 - initial version
-   ! 
-   !> @param[in] cd_varin  string of character with operation inside
-   !> parentheses 
-   !> @param[out] cd_varout string of character with result of 
-   !> operation inside parentheses
-   !-------------------------------------------------------------------   
-   SUBROUTINE math__parentheses(cd_varin, cd_varout)
-      IMPLICIT NONE
-      ! Argument      
-      CHARACTER(LEN=*) , INTENT(IN)  :: cd_varin
-      CHARACTER(LEN=lc), INTENT(OUT) :: cd_varout
-      ! local variables
-      CHARACTER(LEN=lc)     :: cl_cpt
-      INTEGER(i4)           :: il_ind
-      INTEGER(i4)           :: il_count
-      ! loop indices
-      INTEGER(i4) :: ji
-      !----------------------------------------------------------------
-      il_ind=INDEX(cd_varin,'(')
-      IF( il_ind /= 0 )THEN
-         il_count=0
-         DO ji=il_ind+1,LEN(cd_varin)
-            IF( cd_varin(ji:ji) == '(' )THEN
-               il_count=il_count+1
-            ELSEIF( cd_varin(ji:ji) == ')' )THEN
-               IF( il_count == 0 )THEN
-                  WRITE(cl_cpt,*) math_compute(cd_varin(il_ind+1:ji-1))
-                  cd_varout=TRIM(cd_varin(1:il_ind-1))//TRIM(ADJUSTL(cl_cpt))//&
-                     &        TRIM(cd_varin(ji+1:))
-                  EXIT
-               ELSE
-                  il_count=il_count-1
-               ENDIF
-            ENDIF
-         ENDDO
-      ELSE
-         cd_varout=TRIM(cd_varin)
-      ENDIF
-   
-   END SUBROUTINE math__parentheses
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function compute derivative of 1D array.
-   !> 
-   !> @details 
-   !> optionaly you could specify to take into account east west discontinuity
-   !> (-180° 180° or 0° 360° for longitude variable)
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !
-   !> @param[in] dd_value     1D array of variable to be extrapolated
-   !> @param[in] dd_fill      FillValue of variable
-   !> @param[in] ld_discont   logical to take into account east west discontinuity 
-   !-------------------------------------------------------------------
-   PURE FUNCTION math_deriv_1D( dd_value, dd_fill, ld_discont )
-
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp)   , DIMENSION(:), INTENT(IN) :: dd_value
-      REAL(dp)                 , INTENT(IN) :: dd_fill
-      LOGICAL                  , INTENT(IN), OPTIONAL :: ld_discont
-
-      ! function
-      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1) ) :: math_deriv_1D
-
-      ! local variable
-      INTEGER(i4)                            :: il_imin
-      INTEGER(i4)                            :: il_imax
-      INTEGER(i4), DIMENSION(1)              :: il_shape
-
-      REAL(dp)                               :: dl_min
-      REAL(dp)                               :: dl_max
-      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
-
-      LOGICAL                                :: ll_discont
-
-      ! loop indices
-      INTEGER(i4) :: ji
-
-      INTEGER(i4) :: i1
-      INTEGER(i4) :: i2
-      !----------------------------------------------------------------
-      ! init
-      math_deriv_1D(:)=dd_fill
-
-      ll_discont=.FALSE.
-      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
-
-      il_shape(:)=SHAPE(dd_value(:))
-
-      ALLOCATE( dl_value(3))
-
-      ! compute derivative in i-direction
-      DO ji=1,il_shape(1)
-         
-            il_imin=MAX(ji-1,1)
-            il_imax=MIN(ji+1,il_shape(1))
-
-            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=3
-            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=2
-            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
-               i1=2  ; i2=3
-            ENDIF
-
-            dl_value(i1:i2)=dd_value(il_imin:il_imax)
-            IF( il_imin == 1 )THEN
-               dl_value(:)=EOSHIFT( dl_value(:), &
-               &                    DIM=1,         &
-               &                    SHIFT=-1,      &
-               &                    BOUNDARY=dl_value(1) )
-            ENDIF
-            IF( il_imax == il_shape(1) )THEN
-               dl_value(:)=EOSHIFT( dl_value(:), &
-               &                    DIM=1,         &
-               &                    SHIFT=1,       &
-               &                    BOUNDARY=dl_value(3))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:), dl_value(:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:), dl_value(:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:) < 0._dp ) 
-                     dl_value(:) = dl_value(:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:) > 180._dp ) 
-                     dl_value(:) = dl_value(:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-
-         IF( dl_value( 2) /= dd_fill .AND. & ! ji
-         &   dl_value( 3) /= dd_fill .AND. & ! ji+1
-         &   dl_value( 1) /= dd_fill )THEN   ! ji-1
-
-            math_deriv_1D(ji)=&
-            &  ( dl_value(3) - dl_value(1) ) / &
-            &  REAL( il_imax-il_imin ,dp)
-
-         ENDIF
-
-      ENDDO
-
-      DEALLOCATE( dl_value )
-
-   END FUNCTION math_deriv_1D
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function compute derivative of 2D array.
-   !> you have to specify in which direction derivative have to be computed:
-   !> first (I) or second (J) dimension. 
-   !>
-   !> @details 
-   !> optionaly you could specify to take into account east west discontinuity
-   !> (-180° 180° or 0° 360° for longitude variable)
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !
-   !> @param[in] dd_value     2D array of variable to be extrapolated
-   !> @param[in] dd_fill      FillValue of variable
-   !> @param[in] cd_dim       compute derivative on first (I) or second (J) dimension 
-   !> @param[in] ld_discont   logical to take into account east west discontinuity 
-   !-------------------------------------------------------------------
-   FUNCTION math_deriv_2D( dd_value, dd_fill, cd_dim, ld_discont )
-
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_value
-      REAL(dp)                   , INTENT(IN) :: dd_fill
-      CHARACTER(LEN=*)           , INTENT(IN) :: cd_dim
-      LOGICAL                    , INTENT(IN), OPTIONAL :: ld_discont
-
-      ! function
-      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
-      &                   SIZE(dd_value,DIM=2) ) :: math_deriv_2D
-
-      ! local variable
-      INTEGER(i4)                              :: il_imin
-      INTEGER(i4)                              :: il_imax
-      INTEGER(i4)                              :: il_jmin
-      INTEGER(i4)                              :: il_jmax
-      INTEGER(i4), DIMENSION(2)                :: il_shape
-
-      REAL(dp)                                 :: dl_min
-      REAL(dp)                                 :: dl_max
-      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
-
-      LOGICAL                                  :: ll_discont
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
-
-      INTEGER(i4) :: i1
-      INTEGER(i4) :: i2
-
-      INTEGER(i4) :: j1
-      INTEGER(i4) :: j2
-      !----------------------------------------------------------------
-      ! init
-      math_deriv_2D(:,:)=dd_fill
-
-      ll_discont=.FALSE.
-      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
-
-      il_shape(:)=SHAPE(dd_value(:,:))
-
-      SELECT CASE(TRIM(fct_upper(cd_dim)))
-
-      CASE('I')
-
-         ALLOCATE( dl_value(3,il_shape(2)) )
-         ! compute derivative in i-direction
-         DO ji=1,il_shape(1)
-
-            ! init
-            dl_value(:,:)=dd_fill
-            
-            il_imin=MAX(ji-1,1)
-            il_imax=MIN(ji+1,il_shape(1))
-
-            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=3
-            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=2
-            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
-               i1=2  ; i2=3
-            ENDIF
-
-            dl_value(i1:i2,:)=dd_value(il_imin:il_imax,:)
-            IF( il_imin == 1 )THEN
-               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
-               &                      DIM=1,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(1,:) )
-            ENDIF
-            IF( il_imax == il_shape(1) )THEN
-               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
-               &                      DIM=1,         &
-               &                      SHIFT=1,       &
-               &                      BOUNDARY=dl_value(3,:))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:) < 0_dp ) 
-                     dl_value(:,:) = dl_value(:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:) > 180 ) 
-                     dl_value(:,:) = dl_value(:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-            
-            WHERE( dl_value(2,:) /= dd_fill .AND. &  ! ji
-            &      dl_value(3,:) /= dd_fill .AND. &  ! ji+1
-            &      dl_value(1,:) /= dd_fill )        ! ji-1
-
-               math_deriv_2D(ji,:)=&
-               &  ( dl_value(3,:) - dl_value(1,:) ) / &
-               &    REAL( il_imax-il_imin,dp)
-
-            END WHERE
-
-         ENDDO
-
-      CASE('J')
-
-         ALLOCATE( dl_value(il_shape(1),3) )
-         ! compute derivative in j-direction
-         DO jj=1,il_shape(2)
-         
-            il_jmin=MAX(jj-1,1)
-            il_jmax=MIN(jj+1,il_shape(2))
-
-            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
-               j1=1  ; j2=3
-            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
-               j1=1  ; j2=2
-            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
-               j1=2  ; j2=3
-            ENDIF
-
-            dl_value(:,j1:j2)=dd_value(:,il_jmin:il_jmax)
-            IF( il_jmin == 1 )THEN
-               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
-               &                      DIM=2,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(:,1))
-            ENDIF
-            IF( il_jmax == il_shape(2) )THEN
-               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
-               &                      DIM=2,         &
-               &                      SHIFT=1,       &
-               &                      BOUNDARY=dl_value(:,3))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:) < 0_dp ) 
-                     dl_value(:,:) = dl_value(:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:) > 180 ) 
-                     dl_value(:,:) = dl_value(:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-
-            WHERE( dl_value(:, 2) /= dd_fill .AND. & ! jj
-            &      dl_value(:, 3) /= dd_fill .AND. & ! jj+1
-            &      dl_value(:, 1) /= dd_fill )       ! jj-1
-
-               math_deriv_2D(:,jj)=&
-               &  ( dl_value(:,3) - dl_value(:,1) ) / &
-               &   REAL(il_jmax-il_jmin,dp)         
-
-            END WHERE
-
-         ENDDO
-         
-      END SELECT
-
-      DEALLOCATE( dl_value )
-
-   END FUNCTION math_deriv_2D
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function compute derivative of 3D array.
-   !> you have to specify in which direction derivative have to be computed:
-   !> first (I), second (J) or third (K) dimension.
-   !> 
-   !> @details 
-   !> optionaly you could specify to take into account east west discontinuity
-   !> (-180° 180° or 0° 360° for longitude variable)
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !
-   !> @param[inout] dd_value  3D array of variable to be extrapolated
-   !> @param[in] dd_fill      FillValue of variable
-   !> @param[in] cd_dim       compute derivative on first (I) second (J) or third (K) dimension   
-   !> @param[in] ld_discont   logical to take into account east west discontinuity
-   !-------------------------------------------------------------------
-   PURE FUNCTION math_deriv_3D( dd_value, dd_fill, cd_dim, ld_discont )
-
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp)        , DIMENSION(:,:,:), INTENT(IN) :: dd_value
-      REAL(dp)                          , INTENT(IN) :: dd_fill
-      CHARACTER(LEN=*)                  , INTENT(IN) :: cd_dim
-      LOGICAL                           , INTENT(IN), OPTIONAL :: ld_discont
-
-      ! function
-      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
-      &                   SIZE(dd_value,DIM=2), &
-      &                   SIZE(dd_value,DIM=3)) :: math_deriv_3D
-
-      ! local variable
-      INTEGER(i4)                                :: il_imin
-      INTEGER(i4)                                :: il_imax
-      INTEGER(i4)                                :: il_jmin
-      INTEGER(i4)                                :: il_jmax
-      INTEGER(i4)                                :: il_kmin
-      INTEGER(i4)                                :: il_kmax
-      INTEGER(i4), DIMENSION(3)                  :: il_shape
-
-      REAL(dp)                                   :: dl_min
-      REAL(dp)                                   :: dl_max
-      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value
-
-      LOGICAL                                    :: ll_discont
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
-      INTEGER(i4) :: jk
-
-      INTEGER(i4) :: i1
-      INTEGER(i4) :: i2
-
-      INTEGER(i4) :: j1
-      INTEGER(i4) :: j2
-      
-      INTEGER(i4) :: k1
-      INTEGER(i4) :: k2      
-      !----------------------------------------------------------------
-      ! init
-      math_deriv_3D(:,:,:)=dd_fill
-
-      ll_discont=.FALSE.
-      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
-
-      il_shape(:)=SHAPE(dd_value(:,:,:))
-
-
-      SELECT CASE(TRIM(fct_upper(cd_dim)))
-
-      CASE('I')
-
-         ALLOCATE( dl_value(3,il_shape(2),il_shape(3)) )
-         ! compute derivative in i-direction
-         DO ji=1,il_shape(1)
-            
-            il_imin=MAX(ji-1,1)
-            il_imax=MIN(ji+1,il_shape(1))
-
-            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=3
-            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=2
-            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
-               i1=2  ; i2=3
-            ENDIF
-
-            dl_value(i1:i2,:,:)=dd_value(il_imin:il_imax,:,:)
-            IF( il_imin == 1 )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=1,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(1,:,:) )
-            ENDIF
-            IF( il_imax == il_shape(1) )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=1,         &
-               &                      SHIFT=1,       &
-               &                      BOUNDARY=dl_value(3,:,:))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:,:) < 0_dp ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:,:) > 180 ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-
-            WHERE( dl_value(2,:,:) /= dd_fill .AND. & ! ji
-            &      dl_value(3,:,:) /= dd_fill .AND. & !ji+1 
-            &      dl_value(1,:,:) /= dd_fill )       !ji-1
-
-               math_deriv_3D(ji,:,:)= &
-               &  ( dl_value(3,:,:) - dl_value(1,:,:) ) / &
-               &  REAL( il_imax-il_imin ,dp)
-
-            END WHERE
-
-         ENDDO
-
-      CASE('J')
-
-         ALLOCATE( dl_value(il_shape(1),3,il_shape(3)) )
-         ! compute derivative in j-direction
-         DO jj=1,il_shape(2)
-         
-            il_jmin=MAX(jj-1,1)
-            il_jmax=MIN(jj+1,il_shape(2))
-
-            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
-               j1=1  ; j2=3
-            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
-               j1=1  ; j2=2
-            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
-               j1=2  ; j2=3
-            ENDIF
-
-            dl_value(:,j1:j2,:)=dd_value(:,il_jmin:il_jmax,:)
-            IF( il_jmin == 1 )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=2,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(:,1,:) )
-            ENDIF
-            IF( il_jmax == il_shape(2) )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=2,         &
-               &                      SHIFT=1,       &
-               &                      BOUNDARY=dl_value(:,3,:))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:,:) < 0_dp ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:,:) > 180 ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-
-            WHERE( dl_value(:, 2,:) /= dd_fill .AND. & ! jj
-               &   dl_value(:, 3,:) /= dd_fill .AND. & ! jj+1
-            &      dl_value(:, 1,:) /= dd_fill )       ! jj-1
-
-               math_deriv_3D(:,jj,:)=&
-               &  ( dl_value(:,3,:) - dl_value(:,1,:) ) / &
-               &  REAL( il_jmax - il_jmin ,dp)         
-
-            END WHERE
-
-         ENDDO
-         
-      CASE('K')
-         ! compute derivative in k-direction
-         DO jk=1,il_shape(3)
-
-            il_kmin=MAX(jk-1,1)
-            il_kmax=MIN(jk+1,il_shape(3))
-
-            IF( il_kmin==jk-1 .AND. il_kmax==jk+1 )THEN
-               k1=1  ; k2=3
-            ELSEIF( il_kmin==jk .AND. il_kmax==jk+1 )THEN
-               k1=1  ; k2=2
-            ELSEIF( il_kmin==jk-1 .AND. il_kmax==jk )THEN
-               k1=2  ; k2=3
-            ENDIF
-
-            dl_value(:,:,k1:k2)=dd_value(:,:,il_kmin:il_kmax)
-            IF( il_kmin == 1 )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=3,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(:,:,1) )
-            ENDIF
-            IF( il_kmax == il_shape(3) )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                        DIM=3,         &
-               &                        SHIFT=1,       &
-               &                        BOUNDARY=dl_value(:,:,3))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:,:) < 0_dp ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:,:) > 180 ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF         
-
-            WHERE( dl_value(:,:, 2) /= dd_fill .AND. & ! jk
-               &   dl_value(:,:, 3) /= dd_fill .AND. & ! jk+1
-               &   dl_value(:,:, 1) /= dd_fill )       ! jk-1
-
-               math_deriv_3D(:,:,jk)=&
-               &  ( dl_value(:,:,3) - dl_value(:,:,1) ) / &
-               &  REAL( il_kmax-il_kmin,dp)         
-
-            END WHERE
-
-         ENDDO
-
-      END SELECT
-
-      DEALLOCATE( dl_value )
-
-   END FUNCTION math_deriv_3D
-END MODULE math
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 10251)
@@ -28,7 +28,4 @@
 !> @endcode
 !>    
-!> @note 
-!>    you could find a template of the namelist in templates directory.
-!>
 !>    merge_bathy.nam comprise 8 namelists:
 !>       - logger namelist (namlog)
@@ -48,5 +45,5 @@
 !>       - cn_logfile   : logger filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!>  'warning','error','fatal','none')
+!>  'warning','error','fatal')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -65,10 +62,10 @@
 !>    * _variable namelist (namvar)_:
 !>       - cn_varinfo : list of variable and extra information about request(s) 
-!>       to be used (separated by ',').<br/>
+!>       to be used.<br/>
 !>          each elements of *cn_varinfo* is a string character.<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - int = interpolation method
+!>             - interpolation method
 !> 
 !>                requests must be separated by ';'.<br/>
@@ -77,5 +74,5 @@
 !>          informations about available method could be find in 
 !>          @ref interp modules.<br/>
-!>          Example: 'bathymetry: int=cubic'
+!>          Example: 'bathymetry: cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -98,9 +95,9 @@
 !>          segments are separated by '|'.<br/>
 !>          each segments of the boundary is composed of:
-!>             - indice of velocity (orthogonal to boundary .ie. 
-!>                for north boundary, J-indice). 
-!>             - indice of segment start (I-indice for north boundary) 
-!>             - indice of segment end   (I-indice for north boundary)<br/>
-!>                indices must be separated by ':' .<br/>
+!>             - orthogonal indice (.ie. for north boundary,
+!>             J-indice where boundary are). 
+!>             - first indice of boundary (I-indice for north boundary) 
+!>             - last  indice of boundary (I-indice for north boundary)<br/>
+!>                indices must be separated by ',' .<br/>
 !>             - optionally, boundary size could be added between '(' and ')' 
 !>             in the first segment defined.
@@ -109,7 +106,6 @@
 !>
 !>          Examples:
-!>             - cn_north='index1,first1:last1(width)'
-!>             - cn_north='index1(width),first1:last1|index2,first2:last2'
-!>
+!>             - cn_north='index1,first1,last1(width)'
+!>             - cn_north='index1(width),first1,last1|index2,first2,last2'
 !>       - cn_south : south boundary indices on fine grid<br/>
 !>       - cn_east  : east  boundary indices on fine grid<br/>
@@ -125,7 +121,4 @@
 !> @date Sepember, 2014 
 !> - add header for user
-!> @date July, 2015 
-!> - extrapolate all land points
-!> - add attributes with boundary string character (as in namelist)
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -160,5 +153,4 @@
    CHARACTER(LEN=lc)                                  :: cl_namelist
    CHARACTER(LEN=lc)                                  :: cl_date
-   CHARACTER(LEN=lc)                                  :: cl_tmp
 
    INTEGER(i4)                                        :: il_narg
@@ -170,5 +162,4 @@
    INTEGER(i4)                                        :: il_jmin0
    INTEGER(i4)                                        :: il_jmax0
-   INTEGER(i4)                                        :: il_shift
    INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
    INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
@@ -240,6 +231,5 @@
    NAMELIST /namlog/ &  !< logger namelist
    &  cn_logfile,    &  !< log file
-   &  cn_verbosity,  &  !< log verbosity
-   &  in_maxerror       !< logger maximum error
+   &  cn_verbosity      !< log verbosity
 
    NAMELIST /namcfg/ &  !< config namelist
@@ -308,5 +298,5 @@
       READ( il_fileid, NML = namlog )
       ! define log file
-      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity), in_maxerror)
       CALL logger_header()
 
@@ -520,78 +510,4 @@
    ENDIF
 
-
-   IF( tl_bdy(jp_north)%l_use )THEN
-      ! add shift on north boundary
-      ! boundary compute on T point but express on U or V point
-      il_shift=1
-
-      cl_tmp=TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_index-il_shift))//','//&
-         &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_first))//':'//&
-         &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_last))//&
-         &   '('//TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_width))//')'
-      DO ji=2,tl_bdy(jp_north)%i_nseg
-         cl_tmp=TRIM(cl_tmp)//'|'//&
-            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_index-il_shift))//','//&
-            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_first))//':'//&
-            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_last))
-      ENDDO
-      tl_att=att_init("bdy_north",TRIM(cl_tmp))
-      CALL file_add_att(tl_fileout, tl_att)
-   ENDIF
-
-   IF( tl_bdy(jp_south)%l_use )THEN
-      
-      cl_tmp=TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_index))//','//&
-         &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_first))//':'//&
-         &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_last))//&
-         &   '('//TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_width))//')'
-      DO ji=2,tl_bdy(jp_south)%i_nseg
-         cl_tmp=TRIM(cl_tmp)//'|'//&
-            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_index))//','//&
-            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_first))//':'//&
-            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_last))
-      ENDDO
-
-      tl_att=att_init("bdy_south",TRIM(cl_tmp))
-      CALL file_add_att(tl_fileout, tl_att)
-   ENDIF
-
-   IF( tl_bdy(jp_east)%l_use )THEN
-      ! add shift on east boundary
-      ! boundary compute on T point but express on U or V point
-      il_shift=1
-
-      cl_tmp=TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_index-il_shift))//','//&
-         &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_first))//':'//&
-         &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_last))//&
-         &   '('//TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_width))//')'
-      DO ji=2,tl_bdy(jp_east)%i_nseg
-         cl_tmp=TRIM(cl_tmp)//'|'//&
-            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_index-il_shift))//','//&
-            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_first))//':'//&
-            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_last))
-      ENDDO
-
-      tl_att=att_init("bdy_east",TRIM(cl_tmp))
-      CALL file_add_att(tl_fileout, tl_att)
-   ENDIF
-
-   IF( tl_bdy(jp_west)%l_use )THEN
-
-      cl_tmp=TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_index))//','//&
-         &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_first))//':'//&
-         &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_last))//&
-         &   '('//TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_width))//')'
-      DO ji=2,tl_bdy(jp_west)%i_nseg
-         cl_tmp=TRIM(cl_tmp)//'|'//&
-            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_index))//','//&
-            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_first))//':'//&
-            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_last))
-      ENDDO
-
-      tl_att=att_init("bdy_west",TRIM(cl_tmp))
-      CALL file_add_att(tl_fileout, tl_att)
-   ENDIF
-
    ! create file
    CALL iom_create(tl_fileout)
@@ -609,5 +525,4 @@
    CALL mpp_clean(tl_bathy0)
    DEALLOCATE(dl_weight)
-   CALL boundary_clean(tl_bdy(:))
 
    ! close log file
@@ -993,5 +908,7 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var )
+      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), &
+      &                               id_rho=id_rho(:),         &
+      &                               id_iext=il_iext, id_jext=il_jext )
 
       ! interpolate Bathymetry
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/mpp.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 10251)
@@ -165,11 +165,13 @@
 !>    to get processors to be used:<br/>
 !> @code
-!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, & 
-!>    &                         id_jmin, id_jmax )
+!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim, & 
+!>    &                         id_jmin, id_jmax, id_jdim )
 !> @endcode
 !>       - id_imin 
 !>       - id_imax 
+!>       - id_idim 
 !>       - id_jmin 
 !>       - id_jmax 
+!>       - id_jdim 
 !>
 !>    to get sub domains which form global domain contour:<br/>
@@ -350,5 +352,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator 
@@ -377,5 +379,4 @@
       ! copy mpp variable
       mpp__copy_unit%c_name     = TRIM(td_mpp%c_name)
-      mpp__copy_unit%i_id       = td_mpp%i_id
       mpp__copy_unit%i_niproc   = td_mpp%i_niproc
       mpp__copy_unit%i_njproc   = td_mpp%i_njproc
@@ -424,5 +425,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator 
@@ -453,5 +454,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - Nov, 2013- Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -494,5 +495,5 @@
       ! print dimension
       IF(  td_mpp%i_ndim /= 0 )THEN
-         WRITE(*,'(/a)') " MPP dimension"
+         WRITE(*,'(/a)') " File dimension"
          DO ji=1,ip_maxdim
             IF( td_mpp%t_dim(ji)%l_use )THEN
@@ -697,5 +698,5 @@
       CALL dim_clean(tl_dim)
 
-      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. &
+      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_niproc))) .OR. &
           ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN
           CALL logger_warn( "MPP INIT: number of processors following I and J "//&
@@ -911,5 +912,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file strcuture
@@ -1027,29 +1028,29 @@
             ! create some attributes for domain decomposition (use with dimg file)
             tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej )
-            CALL mpp_move_att(mpp__init_file, tl_att)
+            CALL mpp_add_att(mpp__init_file, tl_att)
             
             ! clean
@@ -1121,4 +1122,5 @@
       CALL file_clean(tl_file)
 
+      CALL logger_debug("MPP INIT READ: fin init_read ")
    END FUNCTION mpp__init_file
    !-------------------------------------------------------------------
@@ -1129,6 +1131,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 - add only use dimension in MPP structure
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_file   file strcuture
@@ -1162,6 +1163,6 @@
          IF( td_file%i_id == 0 )THEN
             CALL logger_info(" id "//TRIM(fct_str(td_file%i_id))) 
-            CALL logger_error("MPP INIT READ: netcdf file "//&
-               &  TRIM(td_file%c_name)//" not opened")
+            CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//&
+            &  " not opened")
          ELSE
 
@@ -1190,14 +1191,9 @@
                CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
             ENDIF
-
-            IF( td_file%t_dim(3)%l_use )THEN
-               tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len)
-               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
-            ENDIF
-
-            IF( td_file%t_dim(4)%l_use )THEN
-               tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len)
-               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
-            ENDIF
+            tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len)
+            CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+
+            tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len)
+            CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
 
             ! initialise file/processor
@@ -1316,5 +1312,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   file strcuture
@@ -1536,5 +1532,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - Nov, 2013- Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -1628,4 +1624,8 @@
             IF( il_varid /= 0 )THEN
 
+               CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", already in mpp "//TRIM(td_mpp%c_name) )
+
                DO ji=1,td_mpp%t_proc(1)%i_nvar
                   CALL logger_debug( " MPP ADD VAR: in mpp structure : &
@@ -1634,7 +1634,4 @@
                   &  TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) )
                ENDDO
-               CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&
-               &  ", standard name "//TRIM(td_var%c_stdname)//&
-               &  ", already in mpp "//TRIM(td_mpp%c_name) )
 
             ELSE
@@ -1678,5 +1675,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -1843,6 +1840,4 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial version
-   !> @date February, 2015 
-   !> - define local variable structure to avoid mistake with pointer
    !
    !> @param[inout] td_mpp    mpp strcuture
@@ -1857,5 +1852,4 @@
       ! local variable
       INTEGER(i4)       :: il_varid
-      TYPE(TVAR)        :: tl_var
       !----------------------------------------------------------------
       ! check if mpp exist
@@ -1888,6 +1882,5 @@
             ELSE
 
-               tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
-               CALL mpp_del_var(td_mpp, tl_var)
+               CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid)) 
 
             ENDIF
@@ -2200,7 +2193,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - rewrite the same as way var_add_dim
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2217,33 +2208,51 @@
 
       ! loop indices
+      INTEGER(i4) :: ji
       !----------------------------------------------------------------
       IF( td_mpp%i_ndim <= ip_maxdim )THEN
 
-         ! check if dimension already used in mpp structure
-         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
-         IF( il_ind == 0 )THEN
-            CALL logger_warn( &
-            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
-            &  ", short name "//TRIM(td_dim%c_sname)//&
-            &  ", will not be added in mpp "//TRIM(td_mpp%c_name) )
-         ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN
-            CALL logger_error( &
-            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
-            &  ", short name "//TRIM(td_dim%c_sname)//&
-            &  ", already used in mpp "//TRIM(td_mpp%c_name) )
+         ! check if dimension already in mpp structure
+         il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
+         IF( il_ind /= 0 )THEN
+
+            IF( td_mpp%t_dim(il_ind)%l_use )THEN
+               CALL logger_error( &
+               &  "MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+               &  ", short name "//TRIM(td_dim%c_sname)//&
+               &  ", already used in mpp "//TRIM(td_mpp%c_name) )
+            ELSE
+               ! replace dimension
+               td_mpp%t_dim(il_ind)=dim_copy(td_dim)
+               td_mpp%t_dim(il_ind)%i_id=il_ind
+               td_mpp%t_dim(il_ind)%l_use=.TRUE.
+            ENDIF
+
          ELSE
 
-            ! back to disorder dimension array 
-            CALL dim_disorder(td_mpp%t_dim(:))
-
-            ! add new dimension
-            td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim)
-
-            ! update number of attribute
-            td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
+            IF( td_mpp%i_ndim == ip_maxdim )THEN
+               CALL logger_error( &
+               &  "MPP ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//&
+               &  ", short name "//TRIM(td_dim%c_sname)//&
+               &  ", in mpp "//TRIM(td_mpp%c_name)//". Already "//&
+               &  TRIM(fct_str(ip_maxdim))//" dimensions." )
+            ELSE
+               ! search empty dimension
+               DO ji=1,ip_maxdim
+                  IF( td_mpp%t_dim(ji)%i_id == 0 )THEN
+                     il_ind=ji 
+                     EXIT
+                  ENDIF
+               ENDDO
+ 
+               ! add new dimension    
+               td_mpp%t_dim(il_ind)=dim_copy(td_dim)
+               ! update number of attribute
+               td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
+
+               td_mpp%t_dim(il_ind)%l_use=.TRUE.
+               td_mpp%t_dim(il_ind)%i_id=td_mpp%i_ndim
+            ENDIF
 
          ENDIF
-         ! reorder dimension to ('x','y','z','t')
-         CALL dim_reorder(td_mpp%t_dim(:))
 
       ELSE
@@ -2259,7 +2268,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - rewrite the same as way var_del_dim
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2273,34 +2280,55 @@
 
       ! local variable
+      INTEGER(i4) :: il_status
       INTEGER(i4) :: il_ind
-      TYPE(TDIM)  :: tl_dim
+      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim
 
       ! loop indices
-      !----------------------------------------------------------------
-
-
-      IF( td_mpp%i_ndim <= ip_maxdim )THEN
-
-         CALL logger_trace( &
-         &  " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if dimension already in mpp structure
+      il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
+      IF( il_ind == 0 )THEN
+
+         CALL logger_error( &
+         &  "MPP DEL DIM: no dimension "//TRIM(td_dim%c_name)//&
          &  ", short name "//TRIM(td_dim%c_sname)//&
          &  ", in mpp "//TRIM(td_mpp%c_name) )
-         
-         ! check if dimension already in variable structure
-         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
-
-         ! replace dimension by empty one
-         td_mpp%t_dim(il_ind)=dim_copy(tl_dim)
-
-         ! update number of dimension
-         td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
-
-         ! reorder dimension to ('x','y','z','t')
-         CALL dim_reorder(td_mpp%t_dim)
 
       ELSE
-         CALL logger_error( &
-         &  " MPP DEL DIM: too much dimension in mpp "//&
-         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
+
+         ALLOCATE( tl_dim(td_mpp%i_ndim-1), stat=il_status )
+         IF(il_status /= 0 )THEN
+
+            CALL logger_error( &
+            &  "MPP DEL DIM: not enough space to put dimensions from "//&
+            &  TRIM(td_mpp%c_name)//" in temporary dimension structure")
+
+         ELSE
+
+            ! save temporary dimension's mpp structure
+            tl_dim( 1 : il_ind-1 ) = dim_copy(td_mpp%t_dim( 1 : il_ind-1 ))
+            tl_dim( il_ind : td_mpp%i_ndim-1 ) = &
+            &           dim_copy(td_mpp%t_dim( il_ind+1 : td_mpp%i_ndim ))
+
+            ! remove dimension from file
+            CALL dim_clean(td_mpp%t_dim(:))
+            ! copy dimension in file, except one
+            td_mpp%t_dim(1:td_mpp%i_ndim)=dim_copy(tl_dim(:))
+
+            ! update number of dimension
+            td_mpp%i_ndim=td_mpp%i_ndim-1
+
+            ! update dimension id
+            DO ji=1,td_mpp%i_ndim
+               td_mpp%t_dim(ji)%i_id=ji
+            ENDDO
+
+            ! clean
+            CALL dim_clean(tl_dim(:))
+            DEALLOCATE(tl_dim)
+
+         ENDIF
+
       ENDIF
 
@@ -2312,5 +2340,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2460,8 +2488,8 @@
             &  ", in mpp structure "//TRIM(td_mpp%c_name) )
 
-            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
                DO ji=1,td_mpp%t_proc(1)%i_natt
                   CALL logger_debug( "MPP DEL ATT: in mpp structure : &
-                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) )
+                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) )
                ENDDO
             ENDIF
@@ -2488,6 +2516,4 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial version
-   !> @date February, 2015 
-   !> - define local attribute structure to avoid mistake with pointer
    !
    !> @param[inout] td_mpp    mpp strcuture
@@ -2501,6 +2527,5 @@
 
       ! local variable
-      INTEGER(i4) :: il_attid
-      TYPE(TATT)  :: tl_att
+      INTEGER(i4)       :: il_attid
       !----------------------------------------------------------------
       ! check if mpp exist
@@ -2526,5 +2551,5 @@
             IF( il_attid == 0 )THEN
 
-               CALL logger_debug( &
+               CALL logger_warn( &
                &  "MPP DEL ATT : there is no attribute with "//&
                &  "name "//TRIM(cd_name)//" in mpp structure "//&
@@ -2533,6 +2558,5 @@
             ELSE
 
-               tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid))
-               CALL mpp_del_att(td_mpp, tl_att) 
+               CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid)) 
 
             ENDIF
@@ -2839,13 +2863,8 @@
 
             CALL logger_info("MPP OPTIMIZ: number of processor "//&
-            &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
-            &   TRIM(fct_str(tl_mpp%i_nproc)) )
+            &  TRIM(fct_str(tl_mpp%i_nproc)) )
             IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. &
             &   tl_mpp%i_nproc <= il_maxproc )THEN
                ! save optimiz decomposition 
-
-               CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
-               &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
-               &   TRIM(fct_str(tl_mpp%i_nproc)) )
 
                ! clean mpp
@@ -3127,5 +3146,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date November, 2013
    !>
    !> @param[inout] td_mpp mpp strcuture
@@ -3165,5 +3184,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date November, 2013
    !>
    !> @param[in] td_mpp    mpp strcuture
@@ -3230,5 +3249,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date November, 2013
    !
    !> @param[in] td_mpp    mpp strcuture
@@ -3292,5 +3311,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial version
+   !> @date November, 2013
    !>
    !> @param[inout] td_mpp mpp strcuture
@@ -3385,5 +3404,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] td_mpp mpp structure
@@ -3398,4 +3417,5 @@
 
       ! local variable
+      INTEGER(i4) :: il_ndim
 
       ! loop indices
@@ -3409,8 +3429,14 @@
          mpp__check_var_dim=.FALSE.
 
+         CALL logger_error( &
+         &  "MPP CHECK DIM: variable and mpp dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and mpp "//TRIM(td_mpp%c_name))
+
          CALL logger_debug( &
          &  " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//&
          &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) )
-         DO ji = 1, ip_maxdim
+         il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim )
+         DO ji = 1, il_ndim
             CALL logger_debug( &
             &  "MPP CHECK DIM: for dimension "//&
@@ -3422,10 +3448,4 @@
             &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use)))
          ENDDO
-
-         CALL logger_error( &
-         &  "MPP CHECK DIM: variable and mpp dimension differ"//&
-         &  " for variable "//TRIM(td_var%c_name)//&
-         &  " and mpp "//TRIM(td_mpp%c_name))
-
       ENDIF
 
@@ -3436,5 +3456,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_file   array of file structure
@@ -3476,5 +3496,5 @@
    !
    !> @author J.Paul
-   !> @date Ocotber, 2014 - Initial Version
+   !> - Ocotber, 2014- Initial Version
    !
    !> @param[in] td_mpp   mpp file structure
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/multi.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 10251)
@@ -61,6 +61,5 @@
 !> @date October, 2014
 !> - use mpp file structure instead of file
-!> @date November, 2014 
-!> - Fix memory leaks bug
+!> @date November, 2014 - Fix memory leaks bug
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -119,5 +118,5 @@
    !>   
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator (to avoid memory leak)
@@ -170,7 +169,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - check if variable to be read is in file
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] cd_varfile   variable location information (from namelist) 
@@ -193,5 +190,4 @@
 
       INTEGER(i4)       :: il_nvar
-      INTEGER(i4)       :: il_varid
 
       LOGICAL           :: ll_dim
@@ -246,12 +242,4 @@
                   ! define variable
                   IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN
-
-                     ! check if variable is in file
-                     il_varid=var_get_index(tl_mpp%t_proc(1)%t_var(:),cl_lower)
-                     IF( il_varid == 0 )THEN
-                        CALL logger_fatal("MULTI INIT: variable "//&
-                           & TRIM(cl_name)//" not in file "//&
-                           & TRIM(cl_file) )
-                     ENDIF
 
                      ! clean var
@@ -329,5 +317,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_multi  multi file structure
@@ -360,5 +348,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_multi multi file structure
@@ -403,5 +391,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date October, 2014
    !> - use mpp file structure instead of file
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/phycst.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 10251)
@@ -25,5 +25,4 @@
    PUBLIC :: dp_rearth  !< earth radius (km)
    PUBLIC :: dp_deg2rad !< degree to radian ratio 
-   PUBLIC :: dp_rad2deg !< radian to degree ratio 
    PUBLIC :: dp_delta   !<  
 
@@ -32,7 +31,6 @@
    REAL(dp), PARAMETER :: dp_rearth = 6871._dp
    REAL(dp), PARAMETER :: dp_deg2rad = dp_pi/180.0
-   REAL(dp), PARAMETER :: dp_rad2deg = 180.0/dp_pi
 
-   REAL(dp), PARAMETER :: dp_delta=1.e-6
+   REAL(dp), PARAMETER :: dp_delta=1.e-2
 END MODULE phycst
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/variable.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 10251)
@@ -281,8 +281,4 @@
 !> @date November, 2014 
 !> - Fix memory leaks bug
-!> @date June, 2015
-!> - change way to get variable information in namelist
-!> @date July, 2015 
-!> - add subroutine var_chg_unit to change unit of output variable
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -297,5 +293,4 @@
    USE att                             ! attribute manager
    USE dim                             ! dimension manager
-   USE math                            ! mathematical function
    IMPLICIT NONE
    ! NOTE_avoid_public_variables_if_possible
@@ -323,5 +318,4 @@
    PUBLIC :: var_concat        !< concatenate two variables
    PUBLIC :: var_limit_value   !< forced min and max value
-   PUBLIC :: var_chg_unit      !< change variable unit and value
    PUBLIC :: var_max_dim       !< get array of maximum dimension use
    PUBLIC :: var_reorder       !< reorder table of value in variable structure
@@ -388,6 +382,4 @@
    PRIVATE :: var__get_max       ! get maximum value from namelist 
    PRIVATE :: var__get_min       ! get minimum value from namelist
-   PRIVATE :: var__get_unf       ! get scale factor value from namelist
-   PRIVATE :: var__get_unt       ! get unit from namelist
    PRIVATE :: var__get_interp    ! get interpolation method from namelist
    PRIVATE :: var__get_extrap    ! get extrapolation method from namelist
@@ -409,5 +401,5 @@
       TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes
       TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim           !< variable dimension
- 
+      
       LOGICAL           :: l_file = .FALSE.  !< variable read in a file
 
@@ -422,8 +414,5 @@
       REAL(dp)          :: d_min = dp_fill      !< minimum value 
       REAL(dp)          :: d_max = dp_fill      !< maximum value 
- 
-      CHARACTER(LEN=lc) :: c_unt = ''           !< new variables units (linked to units factor)
-      REAL(dp)          :: d_unf = 1._dp        !< units factor
-
+      
       !!! netcdf4
       LOGICAL           :: l_contiguous = .FALSE. !< use contiguous storage or not
@@ -529,5 +518,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date November, 2014
    !> - use function instead of overload assignment operator (to avoid memory leak)
@@ -559,7 +548,4 @@
       var__copy_unit%d_min      = td_var%d_min
       var__copy_unit%d_max      = td_var%d_max
-
-      var__copy_unit%c_unt      = TRIM(td_var%c_unt)
-      var__copy_unit%d_unf      = td_var%d_unf
 
       var__copy_unit%i_type     = td_var%i_type
@@ -591,5 +577,4 @@
       var__copy_unit%c_units    = TRIM(td_var%c_units)
       var__copy_unit%c_axis     = TRIM(td_var%c_axis)
-      var__copy_unit%d_unf      = td_var%d_unf
       var__copy_unit%d_scf      = td_var%d_scf
       var__copy_unit%d_ofs      = td_var%d_ofs
@@ -642,5 +627,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !> @date November, 2014
    !> - use function instead of overload assignment operator 
@@ -671,5 +656,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable strucutre
@@ -710,5 +695,5 @@
    !
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -733,5 +718,5 @@
    !
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -759,5 +744,5 @@
    !
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -803,5 +788,4 @@
    !>   - id_id : variable id (read from a file).
    !>   - id_ew : number of point composing east west wrap band.
-   !>   - dd_unf : real(8) value for units factor attribute.
    !>   - dd_scf : real(8) value for scale factor attribute.
    !>   - dd_ofs : real(8) value for add offset attribute.
@@ -817,6 +801,4 @@
    !>   - cd_extrap  : a array of character defining extrapolation method.
    !>   - cd_filter  : a array of character defining filtering method.
-   !>   - cd_unt : a string character to define output unit
-   !>   - dd_unf : real(8) factor applied to change unit
    !>
    !>  @note most of these optionals arguments will be inform automatically,
@@ -824,9 +806,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 
-   !> - Bug fix: conversion of the FillValue type (float case)
-   !> @date June, 2015 
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !>
    !> @param[in] cd_name         variable name
@@ -855,6 +833,4 @@
    !> @param[in] cd_extrap       extrapolation method
    !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -867,6 +843,5 @@
    &                              ld_contiguous, ld_shuffle,&
    &                              ld_fletcher32, id_deflvl, id_chunksz, &
-   &                              cd_interp, cd_extrap, cd_filter, &
-   &                              cd_unt, dd_unf )
+   &                              cd_interp, cd_extrap, cd_filter )
       IMPLICIT NONE
       ! Argument
@@ -896,6 +871,4 @@
       CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
       CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
 
@@ -960,7 +933,7 @@
                tl_att=att_init('_FillValue', INT(dd_fill,i4) )
             CASE(NF90_FLOAT)
-               tl_att=att_init('_FillValue', REAL(dd_fill,sp) )
+               tl_att=att_init('_FillValue', INT(dd_fill,sp) )
             CASE DEFAULT ! NF90_DOUBLE
-               tl_att=att_init('_FillValue', dd_fill )
+                     tl_att=att_init('_FillValue', dd_fill )
          END SELECT
          CALL var_move_att(var__init, tl_att)
@@ -1065,16 +1038,4 @@
       ENDIF
 
-      ! units factor
-      IF( PRESENT(dd_unf) )THEN
-         tl_att=att_init('units_factor',dd_unf)
-         CALL var_move_att(var__init, tl_att)
-      ENDIF
-
-      ! new units (linked to units factor)
-      IF( PRESENT(cd_unt) )THEN
-         tl_att=att_init('new_units',cd_units)
-         CALL var_move_att(var__init, tl_att)
-      ENDIF
-
       ! add extra information
       CALL var__get_extra(var__init)
@@ -1086,6 +1047,4 @@
       CALL var_del_att(var__init, 'filter')
       CALL var_del_att(var__init, 'src_file')
-      CALL var_del_att(var__init, 'src_i_indices')
-      CALL var_del_att(var__init, 'src_j_indices')
       CALL var_del_att(var__init, 'valid_min')
       CALL var_del_att(var__init, 'valid_max')
@@ -1113,10 +1072,6 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
-   !>
+   !> - November, 2013- Initial Version
+   !
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        1D array of real(8) value
@@ -1145,9 +1100,4 @@
    !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1160,7 +1110,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
       IMPLICIT NONE
       ! Argument
@@ -1190,9 +1138,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -1250,9 +1193,5 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:),           &
-      &                          cd_interp=cd_interp(:),             &
-      &                          cd_extrap=cd_extrap(:),             &
-      &                          cd_filter=cd_filter(:),             &
-      &                          cd_unt=cd_unt, dd_unf=dd_unf )
+      &                          id_chunksz=id_chunksz(:))
    
       ! add value
@@ -1300,13 +1239,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 
-   !> - bug fix: array initialise with dimension
-   !> array not only one value
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> - Bux fix: dimension array initialise not only one value
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -1338,9 +1269,4 @@
    !> no deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1353,7 +1279,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
       IMPLICIT NONE
       ! Argument
@@ -1383,9 +1307,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -1431,5 +1350,5 @@
       ENDIF
 
-      il_count(:)=tl_dim(:)%i_len
+      il_count(:)=tl_dim(1)%i_len
       IF( PRESENT(id_count) )THEN
          IF( SIZE(id_count(:)) /= 2 )THEN
@@ -1462,9 +1381,5 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:),           &
-      &                          cd_interp=cd_interp(:),             &
-      &                          cd_extrap=cd_extrap(:),             &
-      &                          cd_filter=cd_filter(:),             &
-      &                          cd_unt=cd_unt, dd_unf=dd_unf )
+      &                          id_chunksz=id_chunksz(:))
    
       ! add value
@@ -1516,10 +1431,6 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
-   !>
+   !> - November, 2013- Initial Version
+   !
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        1D array of real(8) value
@@ -1550,9 +1461,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1565,7 +1471,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
       IMPLICIT NONE
       ! Argument
@@ -1595,9 +1499,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -1678,9 +1577,5 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:),           &
-      &                          cd_interp=cd_interp(:),             &
-      &                          cd_extrap=cd_extrap(:),             &
-      &                          cd_filter=cd_filter(:),             &
-      &                          cd_unt=cd_unt, dd_unf=dd_unf )
+      &                          id_chunksz=id_chunksz(:))
    
       ! add value
@@ -1728,10 +1623,6 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
-   !>
+   !> - November, 2013- Initial Version
+   !
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        4D array of real(8) value
@@ -1762,9 +1653,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1777,7 +1663,5 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                 cd_interp, cd_extrap, cd_filter, &
-   &                                 cd_unt, dd_unf )
+   &                                 ld_fletcher32, id_deflvl, id_chunksz)
       IMPLICIT NONE
       ! Argument
@@ -1807,9 +1691,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -1844,9 +1723,5 @@
       &                       ld_fletcher32=ld_fletcher32,        &
       &                       id_deflvl=id_deflvl,                &
-      &                       id_chunksz=id_chunksz(:),           &
-      &                       cd_interp=cd_interp(:),             &
-      &                       cd_extrap=cd_extrap(:),             &
-      &                       cd_filter=cd_filter(:),             &
-      &                       cd_unt=cd_unt, dd_unf=dd_unf )
+      &                       id_chunksz=id_chunksz(:))
  
       ! add value
@@ -1883,9 +1758,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -1917,9 +1788,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1932,7 +1798,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -1963,10 +1827,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
-
 
       ! local variable
@@ -2012,9 +1870,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf )
+      &                         id_chunksz=id_chunksz(:))
  
       DEALLOCATE( dl_value )
@@ -2038,9 +1892,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         : variable name
@@ -2072,9 +1922,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      : chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2087,7 +1932,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -2118,9 +1961,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2168,9 +2006,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf )
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -2194,9 +2028,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         : variable name
@@ -2228,9 +2058,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      : chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2243,7 +2068,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -2274,9 +2097,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2325,9 +2143,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -2351,9 +2165,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -2385,9 +2195,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2400,7 +2205,5 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                 cd_interp, cd_extrap, cd_filter, &
-   &                                 cd_unt, dd_unf)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -2431,9 +2234,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2483,9 +2281,5 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:),           &
-      &                      cd_interp=cd_interp(:),             &
-      &                      cd_extrap=cd_extrap(:),             &
-      &                      cd_filter=cd_filter(:),             &
-      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      &                      id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -2509,9 +2303,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         : variable name
@@ -2543,9 +2333,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      : chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2558,7 +2343,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -2589,9 +2372,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2637,9 +2415,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
  
       DEALLOCATE( dl_value )
@@ -2663,9 +2437,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -2695,9 +2465,4 @@
    !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2710,7 +2475,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -2741,9 +2504,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2791,9 +2549,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -2817,9 +2571,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -2851,9 +2601,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2866,7 +2611,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -2897,9 +2640,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2948,9 +2686,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -2974,9 +2708,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -3008,9 +2738,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3023,7 +2748,5 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                 cd_interp, cd_extrap, cd_filter, &
-   &                                 cd_unt, dd_unf)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -3054,10 +2777,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
-
 
       ! local variable
@@ -3107,9 +2824,5 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:),           &
-      &                      cd_interp=cd_interp(:),             &
-      &                      cd_extrap=cd_extrap(:),             &
-      &                      cd_filter=cd_filter(:),             &
-      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      &                      id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -3133,9 +2846,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -3167,9 +2876,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3182,7 +2886,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -3213,9 +2915,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3261,9 +2958,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
  
       DEALLOCATE( dl_value )
@@ -3287,9 +2980,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -3321,9 +3010,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3336,7 +3020,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -3367,9 +3049,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3417,9 +3094,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -3443,9 +3116,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -3477,9 +3146,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3492,7 +3156,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -3523,9 +3185,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3574,9 +3231,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -3600,9 +3253,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -3634,10 +3283,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
-
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3650,7 +3293,5 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                 cd_interp, cd_extrap, cd_filter, &
-   &                                 cd_unt, dd_unf)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -3681,9 +3322,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3733,9 +3369,5 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:),           &
-      &                      cd_interp=cd_interp(:),             &
-      &                      cd_extrap=cd_extrap(:),             &
-      &                      cd_filter=cd_filter(:),             &
-      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      &                      id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -3759,9 +3391,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -3793,9 +3421,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3808,7 +3431,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -3839,10 +3460,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
-
 
       ! local variable
@@ -3888,9 +3503,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
  
       DEALLOCATE( dl_value )
@@ -3914,9 +3525,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -3948,9 +3555,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3963,7 +3565,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -3994,10 +3594,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
-
 
       ! local variable
@@ -4045,9 +3639,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -4071,9 +3661,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -4105,9 +3691,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4120,7 +3701,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -4151,9 +3730,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4202,9 +3776,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -4228,9 +3798,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -4262,9 +3828,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4277,7 +3838,5 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                 cd_interp, cd_extrap, cd_filter, &
-   &                                 cd_unt, dd_unf)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -4308,9 +3867,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4360,9 +3914,5 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:),           &
-      &                      cd_interp=cd_interp(:),             &
-      &                      cd_extrap=cd_extrap(:),             &
-      &                      cd_filter=cd_filter(:),             &
-      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      &                      id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -4386,9 +3936,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -4420,9 +3966,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4435,7 +3976,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -4466,9 +4005,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4514,9 +4048,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
  
       DEALLOCATE( dl_value )
@@ -4540,9 +4070,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -4574,9 +4100,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4589,7 +4110,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -4620,9 +4139,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4670,9 +4184,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -4696,9 +4206,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -4730,9 +4236,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4745,7 +4246,5 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                    cd_interp, cd_extrap, cd_filter, &
-   &                                    cd_unt, dd_unf)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -4776,9 +4275,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4827,9 +4321,5 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:),           &
-      &                         cd_interp=cd_interp(:),             &
-      &                         cd_extrap=cd_extrap(:),             &
-      &                         cd_filter=cd_filter(:),             &
-      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      &                         id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -4853,9 +4343,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015
-   !> - add interp, extrap, and filter argument
-   !> @date July, 2015
-   !> - add unit factor (to change unit)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name         variable name
@@ -4887,9 +4373,4 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
-   !> @param[in] cd_interp       interpolation method
-   !> @param[in] cd_extrap       extrapolation method
-   !> @param[in] cd_filter       filter method
-   !> @param[in] cd_unt          new units (linked to units factor)
-   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4902,7 +4383,5 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
-   &                                 cd_interp, cd_extrap, cd_filter, &
-   &                                 cd_unt, dd_unf)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz)
 
       IMPLICIT NONE
@@ -4933,9 +4412,4 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
-      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
-      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
-      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
-      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
-      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4985,9 +4459,5 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:),           &
-      &                      cd_interp=cd_interp(:),             &
-      &                      cd_extrap=cd_extrap(:),             &
-      &                      cd_filter=cd_filter(:),             &
-      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      &                      id_chunksz=id_chunksz(:))
       
       DEALLOCATE( dl_value )
@@ -5003,5 +4473,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -5053,5 +4523,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -5125,5 +4595,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -5200,5 +4670,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -5275,5 +4745,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -5350,7 +4820,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - add all element of the array in the same time
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -5365,7 +4833,4 @@
       ! local variable
       INTEGER(i4) :: il_natt
-      INTEGER(i4) :: il_status
-      INTEGER(i4) :: il_ind
-      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
 
       ! loop indices
@@ -5375,103 +4840,7 @@
       il_natt=SIZE(td_att(:))
 
-      IF( td_var%i_natt > 0 )THEN
-      ! already other attribute in variable structure
-         ALLOCATE( tl_att(td_var%i_natt), stat=il_status )
-         IF(il_status /= 0 )THEN
-
-            CALL logger_error( &
-            &  " VAR ADD ATT: not enough space to put attributes from "//&
-            &  TRIM(td_var%c_name)//" in temporary attribute structure")
-
-         ELSE
-
-            ! save temporary global attribute's variable structure
-            tl_att(:)=att_copy(td_var%t_att(:))
-
-            CALL att_clean(td_var%t_att(:))
-            DEALLOCATE( td_var%t_att )
-            ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
-            IF(il_status /= 0 )THEN
-
-               CALL logger_error( &
-               &  " VAR ADD ATT: not enough space to put attributes "//&
-               &  "in variable structure "//TRIM(td_var%c_name) )
-
-            ENDIF
-
-            ! copy attribute in variable before
-            td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
-
-            ! clean
-            CALL att_clean(tl_att(:))
-            DEALLOCATE(tl_att)
-            
-         ENDIF
-      ELSE
-      ! no attribute in variable structure
-         IF( ASSOCIATED(td_var%t_att) )THEN
-            CALL att_clean(td_var%t_att(:))
-            DEALLOCATE(td_var%t_att)
-         ENDIF
-         ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
-         IF(il_status /= 0 )THEN
-
-            CALL logger_error( &
-            &  " VAR ADD ATT: not enough space to put attributes "//&
-            &  "in variable structure "//TRIM(td_var%c_name) )
-
-         ENDIF
-      ENDIF
-
-      ALLOCATE( tl_att(il_natt) )
-      tl_att(:)=att_copy(td_att(:))
-
-      ! check if attribute already in variable structure
       DO ji=1,il_natt
-         il_ind=0
-         il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name )
-         IF( il_ind /= 0 )THEN
-            CALL logger_error( &
-            &  " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//&
-            &  ", already in variable "//TRIM(td_var%c_name) )
-            CALL att_clean(tl_att(ji))
-         ENDIF
+         CALL var_add_att(td_var, td_att(ji))
       ENDDO
-
-      ! add new attributes
-      td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:))
-
-      DEALLOCATE(tl_att)
-
-      DO ji=1,il_natt
-         ! highlight some attribute
-         IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. &
-           & td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN
-            SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name))
-
-               CASE("add_offset")
-                  td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1)
-               CASE("scale_factor")
-                  td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1)
-               CASE("_FillValue")
-                  td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1)
-               CASE("ew_overlap")
-                  td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4) 
-               CASE("standard_name")
-                  td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
-               CASE("long_name")
-                  td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
-               CASE("units")
-                  td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
-               CASE("grid_point")
-                  td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
-
-            END SELECT
-         ENDIF
-      ENDDO
-
-      ! update number of attribute
-      td_var%i_natt=td_var%i_natt+il_natt
-
 
    END SUBROUTINE var__add_att_arr
@@ -5481,7 +4850,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - use var__add_att_arr subroutine
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5495,14 +4862,117 @@
 
       ! local variable
-      TYPE(TATT), DIMENSION(1) :: tl_att
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
 
       ! loop indices
+      INTEGER(i4) :: ji
       !----------------------------------------------------------------
 
-      ! copy structure in an array
-      tl_att(1)=att_copy(td_att)
-
-      ! 
-      CALL var_add_att( td_var, tl_att(:) )
+      ! check if attribute already in variable structure
+      il_ind=0
+      IF( ASSOCIATED(td_var%t_att) )THEN
+         il_ind=att_get_index( td_var%t_att(:), td_att%c_name )
+      ENDIF
+
+      IF( il_ind /= 0 )THEN
+
+         CALL logger_error( &
+         &  " VAR ADD ATT: attribute "//TRIM(td_att%c_name)//&
+         &  ", already in variable "//TRIM(td_var%c_name) )
+
+         DO ji=1,td_var%i_natt
+            CALL logger_debug( &
+            &  " VAR ADD ATT: in variable "//TRIM(td_var%t_att(ji)%c_name) )
+         ENDDO
+
+      ELSE
+         
+         CALL logger_trace( &
+         &  " VAR ADD ATT: add attribute "//TRIM(td_att%c_name)//&
+         &  ", in variable "//TRIM(td_var%c_name) )
+
+         IF( td_var%i_natt > 0 )THEN
+         ! already other attribute in variable structure
+            ALLOCATE( tl_att(td_var%i_natt), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  " VAR ADD ATT: not enough space to put attributes from "//&
+               &  TRIM(td_var%c_name)//" in temporary attribute structure")
+
+            ELSE
+
+               ! save temporary global attribute's variable structure
+               tl_att(:)=att_copy(td_var%t_att(:))
+
+               CALL att_clean(td_var%t_att(:))
+               DEALLOCATE( td_var%t_att )
+               ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " VAR ADD ATT: not enough space to put attributes "//&
+                  &  "in variable structure "//TRIM(td_var%c_name) )
+
+               ENDIF
+
+               ! copy attribute in variable before
+               td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
+
+               ! clean
+               CALL att_clean(tl_att(:))
+               DEALLOCATE(tl_att)
+               
+            ENDIF
+         ELSE
+         ! no attribute in variable structure
+            IF( ASSOCIATED(td_var%t_att) )THEN
+               CALL att_clean(td_var%t_att(:))
+               DEALLOCATE(td_var%t_att)
+            ENDIF
+            ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  " VAR ADD ATT: not enough space to put attributes "//&
+               &  "in variable structure "//TRIM(td_var%c_name) )
+
+            ENDIF
+         ENDIF
+         ! update number of attribute
+         td_var%i_natt=td_var%i_natt+1
+
+         ! add new attribute
+         td_var%t_att(td_var%i_natt)=att_copy(td_att)
+
+         !! add new attribute id
+         !td_var%t_att(td_var%i_natt)%i_id=att_get_unit(td_var%t_att(:))
+
+         ! highlight some attribute
+         IF( ASSOCIATED(td_var%t_att(td_var%i_natt)%d_value) .OR. &
+           & td_var%t_att(td_var%i_natt)%c_value /= "none" )THEN
+            SELECT CASE(TRIM(td_var%t_att(td_var%i_natt)%c_name))
+
+               CASE("add_offset")
+                  td_var%d_ofs = td_var%t_att(td_var%i_natt)%d_value(1)
+               CASE("scale_factor")
+                  td_var%d_scf = td_var%t_att(td_var%i_natt)%d_value(1)
+               CASE("_FillValue")
+                  td_var%d_fill = td_var%t_att(td_var%i_natt)%d_value(1)
+               CASE("ew_overlap")
+                  td_var%i_ew = INT(td_var%t_att(td_var%i_natt)%d_value(1),i4) 
+               CASE("standard_name")
+                  td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt)%c_value)
+               CASE("long_name")
+                  td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt)%c_value)
+               CASE("units")
+                  td_var%c_units = TRIM(td_var%t_att(td_var%i_natt)%c_value)
+               CASE("grid_point")
+                  td_var%c_point = TRIM(td_var%t_att(td_var%i_natt)%c_value)
+
+            END SELECT
+         ENDIF
+      ENDIF
 
    END SUBROUTINE var__add_att_unit
@@ -5512,8 +4982,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date February, 2015 
-   !> - define local attribute structure to avoid mistake 
-   !> with pointer
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5529,5 +4996,4 @@
       INTEGER(i4) :: il_ind
 
-      TYPE(TATT)  :: tl_att
       ! loop indices
       !----------------------------------------------------------------
@@ -5541,5 +5007,5 @@
       IF( il_ind == 0 )THEN
 
-         CALL logger_debug( &
+         CALL logger_warn( &
          &  " VAR DEL ATT: no attribute "//TRIM(cd_name)//&
          &  ", in variable "//TRIM(td_var%c_name) )
@@ -5547,6 +5013,5 @@
       ELSE
          
-         tl_att=att_copy(td_var%t_att(il_ind))
-         CALL var_del_att(td_var, tl_att)
+         CALL var_del_att(td_var, td_var%t_att(il_ind))
 
       ENDIF
@@ -5558,8 +5023,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013- Initial Version
-   !> @date February, 2015 
-   !> - delete highlight attribute too, when attribute 
-   !> is deleted
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5578,4 +5040,5 @@
 
       ! loop indices
+      !INTEGER(i4) :: ji
       !----------------------------------------------------------------
 
@@ -5588,5 +5051,5 @@
       IF( il_ind == 0 )THEN
 
-         CALL logger_debug( &
+         CALL logger_warn( &
          &  " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//&
          &  ", in variable "//TRIM(td_var%c_name) )
@@ -5640,4 +5103,9 @@
                td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
 
+               !! change attribute id
+               !DO ji=1,td_var%i_natt
+               !   td_var%t_att(ji)%i_id=ji
+               !ENDDO
+
                ! clean
                CALL att_clean(tl_att(:))
@@ -5645,27 +5113,4 @@
             ENDIF 
          ENDIF
-
-         ! highlight attribute
-         SELECT CASE( TRIM(td_att%c_name) )
-
-            CASE("add_offset")
-               td_var%d_ofs = 0._dp
-            CASE("scale_factor")
-               td_var%d_scf = 1._dp
-            CASE("_FillValue")
-               td_var%d_fill = 0._dp
-            CASE("ew_overlap")
-               td_var%i_ew = -1 
-            CASE("standard_name")
-               td_var%c_stdname = ''
-            CASE("long_name")
-               td_var%c_longname = ''
-            CASE("units")
-               td_var%c_units = ''
-            CASE("grid_point")
-               td_var%c_point = ''
-
-         END SELECT
-
       ENDIF
 
@@ -5676,5 +5121,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5711,5 +5156,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5750,5 +5195,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5766,5 +5211,5 @@
       !----------------------------------------------------------------
 
-      IF( td_var%i_ndim <= ip_maxdim )THEN
+      IF( td_var%i_ndim <= 4 )THEN
 
          ! check if dimension already used in variable structure
@@ -5782,7 +5227,6 @@
          ELSE
 
-            ! back to disorder dimension array 
-            CALL dim_disorder(td_var%t_dim(:))
-
+         ! back to unorder dimension array 
+         CALL dim_unorder(td_var%t_dim(:))
             ! add new dimension
             td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim)
@@ -5809,5 +5253,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5828,5 +5272,5 @@
       !----------------------------------------------------------------
 
-      IF( td_var%i_ndim <= ip_maxdim )THEN
+      IF( td_var%i_ndim <= 4 )THEN
 
          CALL logger_trace( &
@@ -5873,5 +5317,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5916,5 +5360,5 @@
    !>
    !> @author J.Paul
-   !> @date June, 2014 - Initial Version
+   !> - June, 2014- Initial Version
    !
    !> @param[in] td_var array of variables structure
@@ -5942,5 +5386,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var    variable structure
@@ -6049,5 +5493,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6187,5 +5631,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6241,5 +5685,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -6317,5 +5761,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -6393,5 +5837,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -6469,5 +5913,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -6543,5 +5987,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -6613,5 +6057,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6636,5 +6080,5 @@
    !>
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !>
    !> @param[in] td_var       array of variable structure
@@ -6701,5 +6145,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var       array of variable structure
@@ -6756,5 +6200,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var array of variable structure
@@ -6795,5 +6239,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var array of variable structure
@@ -6878,7 +6322,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - new namelist format to get extra information (interpolation,...)
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_file   configuration file of variable
@@ -6915,4 +6357,5 @@
 
          il_fileid=fct_getunit()
+         CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file))
          OPEN( il_fileid, FILE=TRIM(cd_file), &
          &                FORM='FORMATTED',   &
@@ -6923,6 +6366,5 @@
          CALL fct_err(il_status)
          IF( il_status /= 0 )THEN
-            CALL logger_fatal("VAR DEF EXTRA: can not open file "//&
-            &                 TRIM(cd_file))
+            CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file))
          ENDIF
 
@@ -6933,5 +6375,5 @@
          DO WHILE( il_status == 0 )
 
-         ! search line not beginning with comment character
+         ! search line do not beginning with comment character
             IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
                il_nvar=il_nvar+1
@@ -6977,14 +6419,13 @@
                   tg_varextra(ji)%c_axis    =TRIM(fct_split(cl_line,3))
                   tg_varextra(ji)%c_point   =TRIM(fct_split(cl_line,4))
-
-                  cl_interp='int='//TRIM(fct_split(cl_line,5))
+                  tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,5))
+                  tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6))
+
+                  cl_interp=TRIM(fct_split(cl_line,7))
                   tg_varextra(ji)%c_interp(:) = &
                   &  var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp)
                   CALL logger_debug("VAR DEF EXTRA: "//&
                   &  TRIM(tg_varextra(ji)%c_name)//&
-                  &  " "//TRIM(tg_varextra(ji)%c_interp(1)))
-
-                  tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6))
-                  tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7))
+                  &  " "//TRIM(cl_interp))
                ELSE
                   ji=ji-1
@@ -7017,5 +6458,5 @@
    !> @details 
    !> string character format must be : <br/>
-   !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/>
+   !> "varname:interp; filter; extrap; > min; < max"<br/>
    !> you could specify only interpolation, filter or extrapolation method, 
    !> whatever the order. you could find more
@@ -7023,10 +6464,6 @@
    !> \ref extrap module.<br/>
    !> Examples: 
-   !> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.'
-   !> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.'
-   !>
-   !>
-   !> @warning variable should be define in tg_varextra (ie in configuration
-   !> file, to be able to add information from namelist
+   !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.'
+   !> cn_varinfo='votemper:cubic; dist_weight; <40.'
    !>
    !> @note If you do not specify a method which is required, default one is
@@ -7034,7 +6471,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date July, 2015 
-   !> - get unit and unit factor (to change unit) 
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_varinfo   variable information from namelist
@@ -7051,5 +6486,4 @@
       CHARACTER(LEN=lc), DIMENSION(1)              :: cl_extrap
       CHARACTER(LEN=lc), DIMENSION(5)              :: cl_filter
-      CHARACTER(LEN=lc)                            :: cl_unt
 
       INTEGER(i4)                                  :: il_ind
@@ -7058,5 +6492,4 @@
       REAL(dp)                                     :: dl_min
       REAL(dp)                                     :: dl_max
-      REAL(dp)                                     :: dl_unf
 
       TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra
@@ -7075,10 +6508,7 @@
             dl_min=var__get_min(cl_name, cl_method)
             dl_max=var__get_max(cl_name, cl_method)
-            dl_unf=var__get_unf(cl_name, cl_method)
             cl_interp(:)=var__get_interp(cl_name, cl_method)
             cl_extrap(:)=var__get_extrap(cl_name, cl_method)
             cl_filter(:)=var__get_filter(cl_name, cl_method)
-            cl_unt=var__get_unt(cl_name, cl_method)
-
 
             il_ind=var_get_index(tg_varextra(:), TRIM(cl_name))
@@ -7086,6 +6516,4 @@
                IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min
                IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max
-               IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf
-               IF(cl_unt      /='') tg_varextra(il_ind)%c_unt      =cl_unt
                IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:)
                IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:)
@@ -7123,34 +6551,24 @@
                &                               cd_filter=cl_filter(:), &
                &                               dd_min = dl_min, &
-               &                               dd_max = dl_max, &
-               &                               cd_unt = cl_unt, &
-               &                               dd_unf = dl_unf )
+               &                               dd_max = dl_max )
 
             ENDIF
 
             ji=ji+1
-            CALL logger_debug( "VAR CHG EXTRA: name       "//&
+            CALL logger_trace( "VAR CHG EXTRA: name       "//&
             &                  TRIM(tg_varextra(il_ind)%c_name) )
-            CALL logger_debug( "VAR CHG EXTRA: interp     "//&
+            CALL logger_trace( "VAR CHG EXTRA: interp     "//&
             &                  TRIM(tg_varextra(il_ind)%c_interp(1)) )         
-            CALL logger_debug( "VAR CHG EXTRA: filter     "//&
+            CALL logger_trace( "VAR CHG EXTRA: filter     "//&
             &                  TRIM(tg_varextra(il_ind)%c_filter(1)) )         
-            CALL logger_debug( "VAR CHG EXTRA: extrap     "//&
+            CALL logger_trace( "VAR CHG EXTRA: extrap     "//&
             &                  TRIM(tg_varextra(il_ind)%c_extrap(1)) )
             IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN
-               CALL logger_debug( "VAR CHG EXTRA: min value  "//&
+               CALL logger_trace( "VAR CHG EXTRA: min value  "//&
                &                  TRIM(fct_str(tg_varextra(il_ind)%d_min)) )
             ENDIF
             IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN
-               CALL logger_debug( "VAR CHG EXTRA: max value  "//&
+               CALL logger_trace( "VAR CHG EXTRA: max value  "//&
                &                  TRIM(fct_str(tg_varextra(il_ind)%d_max)) )
-            ENDIF
-            IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
-               CALL logger_debug( "VAR CHG EXTRA: new unit  "//&
-               &                  TRIM(tg_varextra(il_ind)%c_unt) )
-            ENDIF
-            IF( tg_varextra(il_ind)%d_unf /= 1. )THEN
-               CALL logger_debug( "VAR CHG EXTRA: new unit factor  "//&
-               &                  TRIM(fct_str(tg_varextra(il_ind)%d_unf)) )
             ENDIF
          ENDDO
@@ -7175,5 +6593,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -7269,5 +6687,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -7390,16 +6808,13 @@
             ENDIF
 
-            ! unt
-            IF( TRIM(td_var%c_unt) == '' .AND. &
-            &   TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
-               td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt)
-            ENDIF
-
-            ! units factor
-            IF( td_var%d_unf == 1._dp .AND. &
-            &   tg_varextra(il_ind)%d_unf /= 1._dp )THEN
-               td_var%d_unf=tg_varextra(il_ind)%d_unf
-            ENDIF
-
+         CALL logger_trace("VAR GET EXTRA: name       "//TRIM(td_var%c_name))
+         CALL logger_trace("VAR GET EXTRA: stdname    "//TRIM(td_var%c_stdname))
+         CALL logger_trace("VAR GET EXTRA: longname   "//TRIM(td_var%c_longname))
+         CALL logger_trace("VAR GET EXTRA: units      "//TRIM(td_var%c_units))
+         CALL logger_trace("VAR GET EXTRA: point      "//TRIM(td_var%c_point))
+         CALL logger_trace("VAR GET EXTRA: interp     "//TRIM(td_var%c_interp(1)))
+         CALL logger_trace("VAR GET EXTRA: filter     "//TRIM(td_var%c_filter(1)))
+         CALL logger_trace("VAR GET EXTRA: min value  "//TRIM(fct_str(td_var%d_min)))
+         CALL logger_trace("VAR GET EXTRA: max value  "//TRIM(fct_str(td_var%d_max)))
          ENDIF
 
@@ -7418,11 +6833,8 @@
    !> 
    !> @details
-   !> minimum value is assume to follow string "min ="
+   !> minimum value is assume to follow sign '>'
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - change way to get information in namelist, 
-   !> value follows string "min ="
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name      variable name
@@ -7455,7 +6867,7 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=INDEX(TRIM(cl_tmp),'min')
+         il_ind=SCAN(TRIM(cl_tmp),'>')
          IF( il_ind /= 0 )THEN
-            cl_min=fct_split(cl_tmp,2,'=')
+            cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:)))
             EXIT
          ENDIF
@@ -7465,5 +6877,5 @@
 
       IF( TRIM(cl_min) /= '' )THEN
-         IF( fct_is_real(cl_min) )THEN
+         IF( fct_is_num(cl_min) )THEN
             READ(cl_min,*) var__get_min
             CALL logger_debug("VAR GET MIN: will use minimum value of "//&
@@ -7482,11 +6894,8 @@
    !> 
    !> @details
-   !> maximum value is assume to follow string "max ="
+   !> maximum value is assume to follow sign '<'
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - change way to get information in namelist, 
-   !> value follows string "max ="
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name      variable name
@@ -7519,7 +6928,7 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=INDEX(TRIM(cl_tmp),'max')
+         il_ind=SCAN(TRIM(cl_tmp),'<')
          IF( il_ind /= 0 )THEN
-            cl_max=fct_split(cl_tmp,2,'=')
+            cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:)))
             EXIT
          ENDIF
@@ -7529,5 +6938,5 @@
 
       IF( TRIM(cl_max) /= '' )THEN
-         IF( fct_is_real(cl_max) )THEN
+         IF( fct_is_num(cl_max) )THEN
             READ(cl_max,*) var__get_max
             CALL logger_debug("VAR GET MAX: will use maximum value of "//&
@@ -7543,87 +6952,18 @@
    !> @brief
    !> This function check if variable information read in namelist contains 
-   !> units factor value and return it if true. 
-   !> 
-   !> @details
-   !> units factor value is assume to follow string "unf ="
-   !>
-   !> @author J.Paul
-   !> @date June, 2015 - Initial Version
-   !
-   !> @param[in] cd_name      variable name
-   !> @param[in] cd_varinfo   variable information read in namelist 
-   !> @return untis factor value to be used (FillValue if none)
-   !-------------------------------------------------------------------
-   FUNCTION var__get_unf( cd_name, cd_varinfo )
-      IMPLICIT NONE
-      ! Argument
-      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
-      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
-
-      ! function
-      REAL(dp) :: var__get_unf
-
-      ! local variable
-      CHARACTER(LEN=lc) :: cl_tmp
-      CHARACTER(LEN=lc) :: cl_unf
-      
-      INTEGER(i4)       :: il_ind
-
-      REAL(dp)          :: rl_unf
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      !----------------------------------------------------------------
-      ! init
-      cl_unf=''
-      var__get_unf=dp_fill
-
-      ji=1
-      cl_tmp=fct_split(cd_varinfo,ji,';')
-      DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=INDEX(TRIM(cl_tmp),'unf')
-         IF( il_ind /= 0 )THEN
-            cl_unf=fct_split(cl_tmp,2,'=')
-            EXIT
-         ENDIF
-         ji=ji+1
-         cl_tmp=fct_split(cd_varinfo,ji,';')         
-      ENDDO
-
-      IF( TRIM(cl_unf) /= '' )THEN
-         rl_unf=math_compute(cl_unf)
-         IF( rl_unf /= dp_fill )THEN
-            var__get_unf = rl_unf
-            CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//&
-               &  "value of "//TRIM(fct_str(var__get_unf))//" for variable "//&
-               &   TRIM(cd_name) )
-         ELSE
-            CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//&
-               &  "value for variable "//TRIM(cd_name)//". check namelist." )
-         ENDIF
-      ENDIF
-
-   END FUNCTION var__get_unf
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function check if variable information read in namelist contains 
    !> interpolation method and return it if true. 
    !> 
    !> @details 
-   !> interpolation method is assume to follow string "int ="
-   !>
+   !> split namelist information, using ';' as separator.
    !> compare method name with the list of interpolation method available (see
    !> module global).
    !> check if factor (*rhoi, /rhoj..) are present.<br/>
    !> Example:<br/> 
-   !> - int=cubic/rhoi ; ext=dist_weight
-   !> - int=bilin
+   !> - cubic/rhoi ; dist_weight
+   !> - bilin
    !> see @ref interp module for more information.
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - change way to get information in namelist, 
-   !> value follows string "int ="
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name      variable name
@@ -7642,5 +6982,4 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
-      CHARACTER(LEN=lc) :: cl_int
       CHARACTER(LEN=lc) :: cl_factor
       
@@ -7661,16 +7000,6 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=INDEX(TRIM(cl_tmp),'int')
-         IF( il_ind /= 0 )THEN
-            cl_int=fct_split(cl_tmp,2,'=')
-            EXIT
-         ENDIF
-         ji=ji+1
-         cl_tmp=fct_split(cd_varinfo,ji,';')         
-      ENDDO
-
-      IF( TRIM(cl_int) /= '' )THEN
          DO jj=1,ip_ninterp
-            il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj)))
+            il_ind= INDEX(fct_lower(cl_tmp),TRIM(cp_interp_list(jj)))
             IF( il_ind /= 0 )THEN
 
@@ -7680,7 +7009,7 @@
                ! look for factor
                IF( il_ind==1 )THEN
-                  cl_factor=cl_int(il_len+1:)
+                  cl_factor=cl_tmp(il_len+1:)
                ELSE
-                  cl_factor=cl_int(1:il_ind-1)
+                  cl_factor=cl_tmp(1:il_ind-1)
                ENDIF
                il_mul=SCAN(TRIM(cl_factor),'*')
@@ -7723,5 +7052,8 @@
             ENDIF
          ENDDO
-      ENDIF
+         IF( jj /= ip_ninterp + 1 ) EXIT
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
 
    END FUNCTION var__get_interp
@@ -7732,18 +7064,14 @@
    !> 
    !> @details 
-   !> extrapolation method is assume to follow string "ext ="
-   !> 
+   !> split namelist information, using ';' as separator.
    !> compare method name with the list of extrapolation method available (see
    !> module global).<br/>
    !> Example:<br/>
-   !> - int=cubic ; ext=dist_weight
-   !> - ext=min_error
+   !> - cubic ; dist_weight
+   !> - min_error
    !> see @ref extrap module for more information.
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - change way to get information in namelist, 
-   !> value follows string "ext ="
+   !> - November, 2013- Initial Version
    !
    !> @param[in] cd_name      variable name
@@ -7762,7 +7090,4 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
-      CHARACTER(LEN=lc) :: cl_ext
-
-      INTEGER(i4)       :: il_ind
 
       ! loop indices
@@ -7776,25 +7101,18 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=INDEX(TRIM(cl_tmp),'ext')
-         IF( il_ind /= 0 )THEN
-            cl_ext=fct_split(cl_tmp,2,'=')
-            EXIT
-         ENDIF
+         DO jj=1,ip_nextrap
+            IF( TRIM(fct_lower(cl_tmp)) == TRIM(cp_extrap_list(jj)) )THEN
+               var__get_extrap(1)=TRIM(cp_extrap_list(jj))
+
+               CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//&
+               &  " will use extrapolation method "//TRIM(var__get_extrap(1)) )
+
+               EXIT
+            ENDIF
+         ENDDO
+         IF( jj /= ip_nextrap + 1 ) EXIT
          ji=ji+1
          cl_tmp=fct_split(cd_varinfo,ji,';')         
       ENDDO
-
-      IF( TRIM(cl_ext) /= '' )THEN
-         DO jj=1,ip_nextrap
-            IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN
-               var__get_extrap(1)=TRIM(cp_extrap_list(jj))
-
-               CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//&
-               &  " will use extrapolation method "//TRIM(var__get_extrap(1)) )
-
-               EXIT
-            ENDIF
-         ENDDO
-      ENDIF
 
 
@@ -7806,21 +7124,17 @@
    !> 
    !> @details 
-   !> filter method is assume to follow string "flt ="
-   !>
+   !> split namelist information, using ';' as separator.
    !> compare method name with the list of filter method available (see
    !> module global).
-   !> look for the number of run, using '*' separator, and method parameters inside
+   !> look for the number of turn, using '*' separator, and method parameters inside
    !> bracket.<br/>
    !> Example:<br/>
-   !> - int=cubic ; flt=2*hamming(2,3)
-   !> - flt=hann
+   !> - cubic ; 2*hamming(2,3)
+   !> - hann
    !> see @ref filter module for more information.
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
-   !> @date June, 2015 
-   !> - change way to get information in namelist, 
-   !> value follows string "flt ="
-   !>
+   !> - November, 2013- Initial Version
+   !
    !> @param[in] cd_name      variable name
    !> @param[in] cd_varinfo   variable information read in namelist 
@@ -7837,5 +7151,4 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
-      CHARACTER(LEN=lc) :: cl_flt
       INTEGER(i4)       :: il_ind
 
@@ -7850,26 +7163,16 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=INDEX(TRIM(cl_tmp),'flt')
-         IF( il_ind /= 0 )THEN
-            cl_flt=fct_split(cl_tmp,2,'=')
-            EXIT
-         ENDIF
-         ji=ji+1
-         cl_tmp=fct_split(cd_varinfo,ji,';')         
-      ENDDO
-      
-      IF( TRIM(cl_flt) /= '' )THEN
          DO jj=1,ip_nfilter
-            il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj)))
+            il_ind=INDEX(fct_lower(cl_tmp),TRIM(cp_filter_list(jj)))
             IF( il_ind /= 0 )THEN
                var__get_filter(1)=TRIM(cp_filter_list(jj))
 
-               ! look for number of run
-               il_ind=SCAN(fct_lower(cl_flt),'*')
+               ! look for number of turn
+               il_ind=SCAN(fct_lower(cl_tmp),'*')
                IF( il_ind /=0 )THEN
-                  IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN
-                     var__get_filter(2)=TRIM(cl_flt(1:il_ind-1))
-                  ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN
-                     var__get_filter(2)=TRIM(cl_flt(il_ind+1:))
+                  IF( fct_is_num(cl_tmp(1:il_ind-1)) )THEN
+                     var__get_filter(2)=TRIM(cl_tmp(1:il_ind-1))
+                  ELSE IF( fct_is_num(cl_tmp(il_ind+1:)) )THEN
+                     var__get_filter(2)=TRIM(cl_tmp(il_ind+1:))
                   ELSE
                      var__get_filter(2)='1'
@@ -7880,16 +7183,16 @@
 
                ! look for filter parameter
-               il_ind=SCAN(fct_lower(cl_flt),'(')
+               il_ind=SCAN(fct_lower(cl_tmp),'(')
                IF( il_ind /=0 )THEN
-                  cl_flt=TRIM(cl_flt(il_ind+1:))
-                  il_ind=SCAN(fct_lower(cl_flt),')')
+                  cl_tmp=TRIM(cl_tmp(il_ind+1:))
+                  il_ind=SCAN(fct_lower(cl_tmp),')')
                   IF( il_ind /=0 )THEN
-                     cl_flt=TRIM(cl_flt(1:il_ind-1))
+                     cl_tmp=TRIM(cl_tmp(1:il_ind-1))
                      ! look for cut-off frequency
-                     var__get_filter(3)=fct_split(cl_flt,1,',')
+                     var__get_filter(3)=fct_split(cl_tmp,1,',')
                      ! look for halo size
-                     var__get_filter(4)=fct_split(cl_flt,2,',')
+                     var__get_filter(4)=fct_split(cl_tmp,2,',')
                      ! look for alpha parameter
-                     var__get_filter(5)=fct_split(cl_flt,3,',')
+                     var__get_filter(5)=fct_split(cl_tmp,3,',')
                   ELSE
                      CALL logger_error("VAR GET FILTER: variable "//&
@@ -7912,61 +7215,10 @@
             ENDIF
          ENDDO
-      ENDIF
-
-   END FUNCTION var__get_filter
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function check if variable information read in namelist contains 
-   !> unit and return it if true. 
-   !> 
-   !> @details 
-   !> unit is assume to follow string "unt ="
-   !>
-   !> @author J.Paul
-   !> @date June, 2015 - Initial Version
-   !
-   !> @param[in] cd_name      variable name
-   !> @param[in] cd_varinfo   variable information read in namelist
-   !> @return unit string character 
-   !-------------------------------------------------------------------
-   FUNCTION var__get_unt( cd_name, cd_varinfo )
-      IMPLICIT NONE
-      ! Argument
-      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
-      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
-
-      ! function
-      CHARACTER(LEN=lc)               :: var__get_unt
-
-      ! local variable
-      CHARACTER(LEN=lc) :: cl_tmp
-      
-      INTEGER(i4)       :: il_ind
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      !----------------------------------------------------------------
-
-      var__get_unt=''
-
-      ji=1
-      cl_tmp=fct_split(cd_varinfo,ji,';')
-      DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=INDEX(TRIM(cl_tmp),'unt')
-         IF( il_ind /= 0 )THEN
-            var__get_unt=fct_split(cl_tmp,2,'=')
-            EXIT
-         ENDIF
+         IF( jj /= ip_nfilter + 1 ) EXIT
          ji=ji+1
          cl_tmp=fct_split(cd_varinfo,ji,';')         
       ENDDO
 
-      IF( TRIM(var__get_unt) /= '' )THEN
-         CALL logger_debug("VAR GET UNIT: will use units "//&
-            &  TRIM(var__get_unt)//" for variable "//&
-            &  TRIM(cd_name) )
-      ENDIF
-
-   END FUNCTION var__get_unt
+   END FUNCTION var__get_filter
    !-------------------------------------------------------------------
    !> @brief 
@@ -7975,5 +7227,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_var array of variable structure
@@ -8033,5 +7285,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -8069,55 +7321,4 @@
    !-------------------------------------------------------------------
    !> @brief
-   !> This subroutine replace unit name of the variable,
-   !> and apply unit factor to the value of this variable.
-   !> 
-   !> @details
-   !> new unit name (unt) and unit factor (unf) are read from the namelist.
-   !>
-   !> @note the variable value should be already read.
-   !>
-   !> @author J.Paul
-   !> @date June, 2015 - Initial Version
-   !
-   !> @param[inout] td_var variable structure
-   !-------------------------------------------------------------------
-   SUBROUTINE var_chg_unit( td_var )
-      IMPLICIT NONE
-      ! Argument
-      TYPE(TVAR), INTENT(INOUT) :: td_var
-
-      ! local variable
-      TYPE(TATT)                :: tl_att
-
-      ! loop indices
-      !----------------------------------------------------------------
-
-      IF( ASSOCIATED(td_var%d_value) )THEN
-         !- change value
-         IF( td_var%d_unf /= 1._dp )THEN
-            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
-               td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf
-            END WHERE
-
-            !- change scale factor and offset to avoid mistake
-            tl_att=att_init('scale_factor',1)
-            CALL var_move_att(td_var, tl_att)
-
-            tl_att=att_init('add_offset',0)
-            CALL var_move_att(td_var, tl_att)
-         ENDIF
-
-         !- change unit name 
-         IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. &
-         &   TRIM(td_var%c_unt) /= '' )THEN
-            tl_att=att_init('units',TRIM(td_var%c_unt))
-            CALL var_move_att(td_var,tl_att)
-         ENDIF
-
-      ENDIF
-
-   END SUBROUTINE var_chg_unit
-   !-------------------------------------------------------------------
-   !> @brief
    !> This subroutine check variable dimension expected, as defined in
    !> file 'variable.cfg'.
@@ -8128,5 +7329,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[inout] td_var    variable structure
@@ -8213,7 +7414,5 @@
    !> 
    !> @author J.Paul
-   !> @date August, 2014 - Initial Version
-   !> @date July 2015 
-   !> - do not use dim_disorder anymore
+   !> - August, 2014- Initial Version
    !
    !> @param[inout] td_var       variable structure
@@ -8239,9 +7438,7 @@
       IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
 
-      CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//&
-         &  " new dimension order "//TRIM(cl_dimorder))
-
       tl_dim(:)=dim_copy(td_var%t_dim(:))
 
+      CALL dim_unorder(tl_dim(:))
       CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
 
@@ -8270,5 +7467,5 @@
    !> 
    !> @author J.Paul
-   !> @date September, 2014 - Initial Version
+   !> - September, 2014- Initial Version
    !
    !> @param[in] td_var array of variable structure 
@@ -8295,5 +7492,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2014 - Initial Version
+   !> - November, 2014- Initial Version
    !
    !> @param[in] td_var time variable structure 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/vgrid.f90
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 10251)
@@ -70,5 +70,4 @@
 !> @date Spetember, 2014
 !> - add header
-!> @date June, 2015 - update subroutine with NEMO 3.6
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -119,5 +118,5 @@
    !>
    !> @author G. Madec
-   !> @date Marsh,2008 - F90: Free form and module
+   !> - 03,08-  G. Madec: F90: Free form and module
    !
    !> @note Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
@@ -140,5 +139,4 @@
    !-------------------------------------------------------------------
    SUBROUTINE vgrid_zgr_z( dd_gdepw, dd_gdept, dd_e3w, dd_e3t,          &
-   &                       dd_e3w_1d, dd_e3t_1d, &
    &                       dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2,    &
    &                       dd_ppdzmin, dd_pphmax, dd_pp_to_be_computed, &
@@ -150,6 +148,4 @@
       REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w
       REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t
-      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w_1d
-      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t_1d
 
       REAL(dp)              , INTENT(IN   ) :: dd_ppkth
@@ -230,5 +226,5 @@
          DO jk = 1, il_jpk
             dl_zw = REAL(jk,dp)
-            dl_zt = REAL(jk,dp) + 0.5_dp
+            dl_zt = REAL(jk,dp) + 0.5
             dd_gdepw(jk) = ( dl_zw - 1.0 ) * dl_za1
             dd_gdept(jk) = ( dl_zt - 1.0 ) * dl_za1
@@ -241,5 +237,5 @@
          DO jk = 1, il_jpk
             dl_zw = REAL( jk,dp)
-            dl_zt = REAL( jk,dp) + 0.5_dp
+            dl_zt = REAL( jk,dp) + 0.5
             dd_gdepw(jk) = ( dl_zsur + dl_za0 * dl_zw + &
             &                dl_za1 * dl_zacr * LOG( COSH( (dl_zw-dl_zkth)/dl_zacr ) ) + &
@@ -259,17 +255,4 @@
       ENDIF
 
-   ! need to be like this to compute the pressure gradient with ISF.
-   ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
-   ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
-      DO jk = 1, il_jpk-1
-         dd_e3t_1d(jk) = dd_gdepw(jk+1)-dd_gdepw(jk) 
-      END DO
-      dd_e3t_1d(il_jpk) = dd_e3t_1d(il_jpk-1) ! we don't care because this level is masked in NEMO
-
-      DO jk = 2, il_jpk
-         dd_e3w_1d(jk) = dd_gdept(jk) - dd_gdept(jk-1) 
-      END DO
-      dd_e3w_1d(1  ) = 2._dp * (dd_gdept(1) - dd_gdepw(1))
-
       ! Control and  print
       ! ==================
@@ -277,10 +260,6 @@
       DO jk = 1, il_jpk
          IF( dd_e3w(jk)  <= 0. .OR. dd_e3t(jk)  <= 0. )then
-            CALL logger_debug("VGRID ZGR Z: e3w or e3t <= 0 ")
+            CALL logger_debug("VGRID ZGR Z: e3w or e3t =< 0 ")
          ENDIF   
-
-         IF( dd_e3w_1d(jk)  <= 0. .OR. dd_e3t_1d(jk)  <= 0. )then
-            CALL logger_debug("VGRID ZGR Z: e3w_1d or e3t_1d <= 0 ")
-         ENDIF
 
          IF( dd_gdepw(jk) < 0. .OR. dd_gdept(jk) < 0. )then
@@ -290,43 +269,4 @@
 
    END SUBROUTINE vgrid_zgr_z
-   !-------------------------------------------------------------------
-   !-------------------------------------------------------------------
-   SUBROUTINE vgrid_zgr_bat( dd_bathy, dd_gdepw, dd_hmin, dd_fill )
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_bathy 
-      REAL(dp), DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw 
-      REAL(dp)                , INTENT(IN   ) :: dd_hmin
-      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
-
-      ! local
-      INTEGER(i4) :: il_jpk
-      
-      REAL(dp)    :: dl_hmin
-      REAL(dp)    :: dl_fill
-
-      ! loop indices
-      INTEGER(i4) :: jk
-      !----------------------------------------------------------------
-      il_jpk = SIZE(dd_gdepw(:))
-
-      dl_fill=0._dp
-      IF( PRESENT(dd_fill) ) dl_fill=dd_fill
-
-      IF( dd_hmin < 0._dp ) THEN
-         jk = - INT( dd_hmin )     ! from a nb of level
-      ELSE
-         jk = MINLOC( dd_gdepw, mask = dd_gdepw > dd_hmin, dim = 1 )  ! from a depth
-      ENDIF
-      
-      dl_hmin = dd_gdepw(jk+1) ! minimum depth = ik+1 w-levels 
-      WHERE( dd_bathy(:,:) <= 0._wp .OR. dd_bathy(:,:) == dl_fill )
-         dd_bathy(:,:) = dl_fill                         ! min=0     over the lands
-      ELSE WHERE
-         dd_bathy(:,:) = MAX(  dl_hmin , dd_bathy(:,:)  )   ! min=dl_hmin over the oceans
-      END WHERE
-      WRITE(*,*) 'Minimum ocean depth: ', dl_hmin, ' minimum number of ocean levels : ', jk      
-
-   END SUBROUTINE vgrid_zgr_bat
    !-------------------------------------------------------------------
    !> @brief This subroutine set the depth and vertical scale factor in partial step
@@ -373,7 +313,6 @@
    !
    !> @author A. Bozec, G. Madec
-   !> @date February, 2009 - F90: Free form and module
-   !> @date February, 2009 
-   !> - A. de Miranda : rigid-lid + islands
+   !> - 02-09 (A. Bozec, G. Madec) F90: Free form and module
+   !> - 02-09 (A. de Miranda)  rigid-lid + islands
    !>
    !> @note Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
@@ -388,7 +327,6 @@
    !-------------------------------------------------------------------
    SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, &
-   &                          dd_gdepw, dd_e3t,               &
-   &                          dd_e3zps_min, dd_e3zps_rat,     &
-   &                          dd_fill )
+   &                         dd_gdepw, dd_e3t,               &
+   &                         dd_e3zps_min, dd_e3zps_rat )
       IMPLICIT NONE
       ! Argument      
@@ -398,13 +336,11 @@
       REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw
       REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_e3t
-      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_min
-      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_rat
-      REAL(dp)                   , INTENT(IN   ), OPTIONAL :: dd_fill
+      REAL(dp)                                   :: dd_e3zps_min
+      REAL(dp)                                   :: dd_e3zps_rat
 
       ! local variable
       REAL(dp) :: dl_zmax     ! Maximum depth
-      !REAL(dp) :: dl_zmin     ! Minimum depth
+      REAL(dp) :: dl_zmin     ! Minimum depth
       REAL(dp) :: dl_zdepth   ! Ajusted ocean depth to avoid too small e3t 
-      REAL(dp) :: dl_fill     
 
       INTEGER(i4) :: il_jpk
@@ -423,14 +359,7 @@
       il_jpjglo=SIZE(id_mbathy(:,:),DIM=2)
 
-      dl_fill=0._dp
-      IF( PRESENT(dd_fill) ) dl_fill=dd_fill
-
       ! Initialization of constant
-      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
-
-      ! bounded value of bathy (min already set at the end of zgr_bat)
-      WHERE( dd_bathy(:,:) /= dl_fill )
-         dd_bathy(:,:) = MIN( dl_zmax ,  dd_bathy(:,:) )
-      END WHERE
+      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk)
+      dl_zmin = dd_gdepw(4)
 
       ! bathymetry in level (from bathy_meter)
@@ -443,8 +372,19 @@
       DO jj = 1, il_jpjglo
          DO ji= 1, il_jpiglo
-            IF( dd_bathy(ji,jj) <= 0._dp )THEN
-               id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4)
-            ELSEIF( dd_bathy(ji,jj) == dl_fill )THEN
-               id_mbathy(ji,jj) = 0_i4
+            IF( dd_bathy(ji,jj) <= 0. )   id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4)
+         END DO
+      END DO
+
+      ! bounded value of bathy
+      ! minimum depth == 3 levels
+      ! maximum depth == gdepw(jpk)+e3t(jpk) 
+      ! i.e. the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk)
+      DO jj = 1, il_jpjglo
+         DO ji= 1, il_jpiglo
+            IF( dd_bathy(ji,jj) <= 0. ) THEN
+               dd_bathy(ji,jj) = 0.e0
+            ELSE
+               dd_bathy(ji,jj) = MAX( dd_bathy(ji,jj), dl_zmin )
+               dd_bathy(ji,jj) = MIN( dd_bathy(ji,jj), dl_zmax )
             ENDIF
          END DO
@@ -461,8 +401,5 @@
          DO jj = 1, il_jpjglo
             DO ji = 1, il_jpiglo
-               IF( dd_bathy(ji,jj) /= dl_fill )THEN
-                  IF( 0. < dd_bathy(ji,jj) .AND. &
-                  &       dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1
-               ENDIF
+               IF( 0. < dd_bathy(ji,jj) .AND. dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1
             END DO
          END DO
@@ -497,5 +434,5 @@
 
    !> @author G.Madec
-   !> @date Marsh, 2008 - Original code
+   !> - 03-08 Original code
    !
    !> @param[in] id_mbathy 
@@ -606,5 +543,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> - November, 2013- Initial Version
    !
    !> @param[in] td_bathy     Bathymetry file structure 
@@ -630,6 +567,4 @@
       REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w 
       REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t
-      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w_1d 
-      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t_1d
 
       INTEGER(i4)                                  :: il_status
@@ -775,7 +710,5 @@
       ALLOCATE( dl_gdepw(in_nlevel), dl_gdept(in_nlevel) ) 
       ALLOCATE(   dl_e3w(in_nlevel),   dl_e3t(in_nlevel) ) 
-      ALLOCATE(   dl_e3w_1d(in_nlevel),   dl_e3t_1d(in_nlevel) ) 
       CALL vgrid_zgr_z( dl_gdepw(:), dl_gdept(:), dl_e3w(:), dl_e3t(:), &
-      &                 dl_e3w_1d, dl_e3t_1d, &
       &                 dn_ppkth, dn_ppkth2, dn_ppacr, dn_ppacr2,       &
       &                 dn_ppdzmin, dn_pphmax, dn_pp_to_be_computed,    &
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 10251)
@@ -19,6 +19,6 @@
 
 &namvar
+   cn_varinfo=
    cn_varfile=
-   cn_varinfo=
 /
 
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 10251)
@@ -60,9 +60,8 @@
    cn_west  = 
    ln_oneseg= 
+   in_extrap= 
 /
 
 &namout
    cn_fileout="boundary_out.nc"      
-   dn_dayofs=
-   ln_extrap=
 /
Index: /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam
===================================================================
--- /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 10250)
+++ /branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 10251)
@@ -12,10 +12,4 @@
    cn_coord0=
    in_perio0=
-/
-
-&namfin
-   cn_coord1=
-   cn_bathy1=
-   in_perio1=
 /
 
@@ -40,4 +34,11 @@
 /
 
+&namfin
+   cn_coord1=
+   cn_bathy1=
+   in_perio1=
+   in_extrap=
+/
+
 &namvar
    cn_varinfo=
@@ -52,8 +53,3 @@
 &namout
    cn_fileout="restart_out.nc"      
-   ln_extrap=
-   in_nipro=
-   in_njproc=
-   in_nproc=
-   cn_type=
 /
